Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub ThumbViewer()
'***************************************************************
' 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'.
'***************************************************************
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")
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 = 200
.Top = 5
.Height = 750
.Width = 900
.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