Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub view_attachments()
'Original by P. Lee at http://groups-beta.google.com/group/microsoft.public.outlook/msg/bb26196e8368100c?hl=en&lr=&ie=UTF-8
'
'This macro pops up a browser window to display the 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 toggle between full size & browser width. Hover over the image to see the
'original size/scaled size. Resize the browser window, right-click on the background, &
'Choose 'Refresh' to resize all the images at once.
'
'Click on the subject to bring up the original email.
'
'Note that the 'Public Declare Sub Sleep...' statement needs to go up at the very top before
'any other macros.
'
'Put a shortcut on your toolbar for easy access.
'***************************************************************
' ver. 1/30/04
' - Select one or multiple emails.
' - Copies files to 'Temporary Internet Files\view_attachments'
' (previously copied files are deleted each time it's run).
' - Only image files are displayed (no others are executed).
' - Right-click images to 'Save As', 'Email', 'Print', 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'.
'***************************************************************
'edited by Julius 22/09/04 to improve HTML layout
'and on 3rd June 2005 to remove code that Outlook was complaining about (intrinsic application not specified...)
'see www.juliushonnor.com/blog/outlook-image-preview for installation instructions
On Error Resume Next
Dim oSelection As Outlook.Selection
Set oSelection = ActiveExplorer.Selection
Set objShell = CreateObject("WScript.Shell")
Set fs = CreateObject("Scripting.FileSystemObject")
vTempInt = objShell.RegRead("HKCU\software\microsoft\" _
& "Windows\CurrentVersion\Explorer\Shell Folders\Cache")
vPath = vTempInt & "\view_attachments\"
If fs.FolderExists(vPath) Then
fs.DeleteFile (vPath & "*.*")
Else
fs.CreateFolder vPath
End If
vBkgrColor = "000000"
vFontColor = "FFFFFF"
vHTMLBody = "View Email Attachments" _
& ""
vEmailNum = 0
For Each obj In oSelection
vEmailNum = vEmailNum + 10
vSubject = "Attachments from: " & obj.Subject & "
"
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 _
& Attachment.FileName & "
" _
& "" _
& "![]()
" & vWidth & "){" & vImg & ".width = " _
& vWidth & ";}"">
"
Next
vHTMLBody = vHTMLBody & "
"
Next
If Not vImg = "" Then
vHTMLBody = vHTMLBody & ""
End If
vHTMLBody = vHTMLBody & ""
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 fs = Nothing
Set objShell = Nothing
Set oSelection = Nothing
Set oOL = Nothing
End Sub