Try this macro I put together. It's even better than the preview pane because you can
select multiple emails & view all the pictures at once.
It only displays images & will not run executables or other types of attachments.
It initially scales large images to the width of the browser popup, but you can click on
the image to expand to full size. Hover over the image to see the original size/scaled
size. See comments in the macro for more details.
Put a shortcut on your toolbar for easy access.
I'm constantly tweaking it, so please try it out & give me some feedback.
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub view_attachments()
'***************************************************************
' ver. 1/24/04
' - Select one or multiple emails.
' - Files are copied to Temporary Internet folders.
' - Only image files are displayed (no others are executed).
' - Right-click images to 'Save As', 'Email', etc.
' - Hover over image to see original size & scaled size.
' - Clicking each image will toggle between original size
' & browser width (unless original size is smaller).
' - To scale all images to browser width, resize the browser,
' right-click on background & choose 'Refresh'.
'***************************************************************
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 objShell = CreateObject("WScript.Shell")
vTempInt = objShell.RegRead("HKCU\software\microsoft\" _
& "Windows\CurrentVersion\Explorer\Shell Folders\Cache")
vPath = vTempInt & "\"
vHTMLBody = "<HTML><title>View Email Attachments</title>" _
& "<body bgcolor=#000000><font face=Arial size=3 color=#FFFFFF>"
vEmailNum = 0
For Each obj In oSelection
vEmailNum = vEmailNum + 10
vSubject = "Attachments from: <b>" _
& obj.Subject & "</b><br>"
vHTMLBody = vHTMLBody & vSubject
vAttachNum = vEmailNum
For Each Attachment In obj.Attachments
vAttachNum = vAttachNum + 1
vImg = "document.img" & vAttachNum
vWidth = "document.body.clientWidth - 20"
Attachment.SaveAsFile (vPath & Attachment.FileName)
vHTMLBody = vHTMLBody _
& "<b>" & Attachment.FileName & "</b><br>" _
& "<a href=""javascript:fWidth(" & vImg & ");"">" _
& "<center><IMG name=""img" & vAttachNum & """ alt="""" hspace=0 " _
& "src=""" & vPath & Attachment.FileName & """ align=baseline " _
& "border=0 " & "onload=""vOrig=String(" & vImg & ".width)" _
& "+ ' x ' + String(" & vImg & ".height);vRatio=(" & vWidth _
& ")/" & vImg & ".width;" & vImg & ".alt='Original Size: ' + " _
& "vOrig + '\n Scaled Size: ';if(" & vImg & ".width <=" _
& vWidth & "){" & vImg & ".alt=" & vImg & ".alt + vOrig;}" _
& "else{" & vImg & ".alt=" & vImg & ".alt + String(" & vWidth _
& ")+ ' x ' + String(Math.round(vRatio *" & vImg & ".height));}" _
& "if (" & vImg & ".width >" & vWidth & "){" & vImg & ".width = " _
& vWidth & ";}""></center></a><br><br><br>"
Next
vHTMLBody = vHTMLBody & "</a><br><br>"
Next
If Not vImg = "" Then
vHTMLBody = vHTMLBody & "<script>function fWidth (vImg){" _
& "vCRLF=vImg.alt.indexOf('\n');vOrgWidth=vImg.alt.substring" _
& "(vImg.alt.indexOf(':')+2, vImg.alt.indexOf('x')-1);" _
& "vRatio=vOrgWidth/vImg.width;if(vImg.width == " & vWidth _
& "|| vOrgWidth <= " & vWidth & "){vImg.width=vOrgWidth;" _
& "vImg.alt=vImg.alt.substring(0,vCRLF) + '\n Scaled Size: '" _
& "+ vImg.alt.substring(vImg.alt.indexOf(':')+2,vCRLF);}else" _
& "{vImg.width=" & vWidth & ";vImg.alt=vImg.alt.substring(0,vCRLF)" _
& "+ '\n Scaled Size: ' + String(" & vWidth & ")+ ' x ' + " _
& "String(Math.round(vRatio * vImg.height));}}</script>"
End If
vHTMLBody = vHTMLBody & "</font></body></html>"
Set ie = CreateObject("internetexplorer.application")
With ie
.toolbar = 0
.menubar = 0
.statusbar = 0
.Left = 100
.Top = 50
.Height = 600
.Width = 800
.navigate "about:blank"
.document.Open
.document.Write vHTMLBody
.document.Close
.Visible = True
End With
vTimer = 0
Do Until ie.readyState = 4 Or vTimer = 10000
Sleep 10
vTimer = vTimer + 10
Loop
Set ie = Nothing
Set objShell = Nothing
Set oSelection = Nothing
Set oOL = Nothing
End Sub