A macro to show images

  • Thread starter Thread starter Janiv Ratson
  • Start date Start date
J

Janiv Ratson

I got a Macro for Showing images : when getting number of pics in mail, by
clicking the macro button it creates an HTML with all the attached pics.
It is a great macro, and it works fine for me for the last 2 weeks, today
after rebooting my system the macro has stop working.
Why ?
When I run it in the Visual Basic editor (embedded in the outlook) it says
that the macro option is disabled.
I changed my security to Medium and restarted outlook(2003), then I had a
message box asking me to choose whether to enable macros or disable them, I
chosed Enable Macros option.

Though it still does not work, I cannot run the Macro.
Why ?
Any suggestions ?
10x,
Janiv.
 
Here's an updated version of the macro I've posted lately to display picture
attachments in an inline format instead of having to click on each attachment
individually.

I had a request to be able to right-click on the images & save them to disk, so
this new version pops up a browser window instead of a new email message. I
like it much better

Like before:
- It's safe, because it won't run any executables or other attachments.
- Put a shortcut to the macro on your toolbar for easy access.
- You can select multiple emails & display all the attachments at once.
- It copies the files to 'c:\attachments_outlook' (creates the directory
if necessary - you can modify the path if you wish).
- It then deletes the specific files that were copied (no others).

Try it out & please post some feedback....


Sub view_attachments()
On Error Resume Next

Dim oOL As Outlook.Application
Dim oSelection As Outlook.Selection

Set oOL = New Outlook.Application
Set oSelection = oOL.ActiveExplorer.Selection
Set fs = CreateObject("Scripting.FileSystemObject")

vPath = "c:\Attachments_Outlook\"
If Not fs.FolderExists(vPath) Then fs.CreateFolder vPath

vHTMLBody = "<HTML><title>View Email Attachments</title>"

For Each obj In oSelection
vSubject = "<FONT face=Arial size=3>Attachments from: <b>" _
& obj.Subject & "</b><br>"
vHTMLBody = vHTMLBody & vSubject
For Each Attachment In obj.Attachments
Attachment.SaveAsFile (vPath & Attachment.FileName)
vHTMLBody = vHTMLBody & Attachment.FileName & "</Font><br>" & _
"<IMG alt="""" hspace=0 src=""" & vPath & Attachment.FileName & _
""" align=baseline border=0><br><br><br>"
Next
Next
vHTMLBody = vHTMLBody & "</html>"

Set ie = CreateObject("internetexplorer.application")
With ie
.toolbar = 0
.menubar = 0
.statusbar = 0
.Left = 100
.Top = 100
.Height = 480
.Width = 640
.navigate "about:blank"
.document.Open
.document.Write vHTMLBody
.document.Close
End With
Do Until ie.readyState = 4: wscript.Sleep 10: Loop
ie.Visible = True
Set ie = Nothing

For Each obj In oSelection
For Each Attachment In obj.Attachments
fs.DeleteFile (vPath & Attachment.FileName)
Next
Next

Set fs = Nothing
Set objMsg = Nothing
Set oSelection = Nothing
Set oOL = Nothing
End Sub
 
This version should fix the problem with not deleting all the files that were
copied & the problem with sometimes not displaying all the images.

This macro allows you to select one or multiple emails & display all the picture
attachments together in a broweser window.

- Put a shortcut to the macro on your toolbar for easy access.
- It's safe, because it won't run any executables or other attachments.
- You can select multiple emails & display all the attachments at once.
- It copies the files to 'c:\attachments_outlook' (creates the directory if
necessary - you can modify the path if you wish).
- It then deletes the specific files that were copied (no others).

(Note that the first line is a public declaration & MUST be placed up at the top
before any other macros.)



Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub view_attachments()
On Error Resume Next

Dim oOL As Outlook.Application
Dim oSelection As Outlook.Selection

Set oOL = New Outlook.Application
Set oSelection = oOL.ActiveExplorer.Selection
Set fs = CreateObject("Scripting.FileSystemObject")

vPath = "c:\Attachments_Outlook\"
If Not fs.FolderExists(vPath) Then fs.CreateFolder vPath

vHTMLBody = "<HTML><title>View Email Attachments</title>"

For Each obj In oSelection
vSubject = "<FONT face=Arial size=3>Attachments from: <b>" _
& obj.Subject & "</b><br>"
vHTMLBody = vHTMLBody & vSubject
For Each Attachment In obj.Attachments
Attachment.SaveAsFile (vPath & Attachment.FileName)
vHTMLBody = vHTMLBody & Attachment.FileName & "</Font><br>" & _
"<IMG alt="""" hspace=0 src=""" & vPath & Attachment.FileName & _
""" align=baseline border=0><br><br><br>"
Next
Next
vHTMLBody = vHTMLBody & "</html>"

Set ie = CreateObject("internetexplorer.application")
With ie
.toolbar = 0
.menubar = 0
.statusbar = 0
.Left = 100
.Top = 100
.Height = 480
.Width = 640
.navigate "about:blank"
.document.Open
.document.Write vHTMLBody
.document.Close
.Visible = True
End With

Do Until ie.readyState = 4: Sleep 10: Loop
Set ie = Nothing

For Each obj In oSelection
For Each Attachment In obj.Attachments
fs.DeleteFile (vPath & Attachment.FileName)
Next
Next

Set fs = Nothing
Set objMsg = Nothing
Set oSelection = Nothing
Set oOL = Nothing
End Sub
 
Thanks so much for the macro - I have been looking high and low over the
last two days for something like this.

So ... just a note to let you know how much it's appreciated.

Tab.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Run Macro If Cell have "x" value 0
Macro to use information in a cell to locate and send files using outlook 0
Excel Macro for deleting Rows containing dates greater than "today" 0
Excel Run macro upon cell edit 0
Disable Macro Alert 2
how to enable macro for addin 3
Macros Error: 1
ThisOutlookSession macro problem 0

Back
Top