Sub ShowImages()
'On Error Resume Next
Dim a As Attachment
Dim i As Integer
Dim pics As Integer
Dim TempDir As String
TempDir = Environ("temp")
pics = 1
For Each a In Application.ActiveExplorer.Selection.Item(1).Attachments
If IsPicture(a.DisplayName) Then
a.SaveAsFile (TempDir & "\attach" & pics)
pics = pics + 1
End If
Next
If pics > 1 Then
Open TempDir & "\attachments.html" For Output As #1
Print #1, ""
For i = 1 To pics - 1
Print #1, "![]()
"
Next
Print #1, ""
Close #1
Shell "C:\Program Files\Internet Explorer\IEXPLORE.EXE " & TempDir & "\attachments.html", vbNormalFocus
End If
End Sub
Function IsPicture(filename As String) As Boolean
ext3 = UCase(Right(filename, 4))
ext4 = UCase(Right(filename, 5))
IsPicture = False
If ext3 = ".BMP" Or ext3 = ".JPG" Or ext3 = ".GIF" Or ext4 = ".JPEG" Or ext4 = ".TIFF" Then
IsPicture = True
End If
End Function
'
'Taking care of temporary files
'
Private Sub Application_Quit()
TempDir = Environ("temp")
On Error Resume Next
Kill TempDir & "\attachments.html"
Kill TempDir & "\attach*."
End Sub