Outlook Scripts

Below are some usefull outlook scripts. Feel free to use them.

To add a macro to outlook you need to click on "Tools"-"Macros"-"Visual Basic Editor".
Right click on the project and choose "Insert"-"Module"
Copy and paste the below macros into the module.

To add a button to the outlook menu bar, right-click on the menubar and click on "Customize..."
Choose "Commands"-"Macros" and drag the macro to the toolbar.
While the dialog is open, right-Click on the button to change its setup.

Make sure the outlook security in "Tools"-"Macro"-"Security" is set to medium (or sign the macro)

1. Macro to open all attached pictures in a mail in Internet Explorer in one click

Sub ShowImages()
    'On Error Resume Next
    Dim a As Attachment
    Dim i As Integer
    Dim pics As Integer
    Dim TempDir As String
    Dim Subject As String
    
    TempDir = VBA.Environ("temp")
    
    pics = 1
    For Each a In Application.ActiveExplorer.Selection.Item(1).Attachments
        If IsPicture(a.DisplayName) Then
            a.SaveAsFile (TempDir & "\Image" & VBA.Format(Application.ActiveExplorer.Selection.Item(1).ReceivedTime, "_ddmmmyyyy_hhmm_") & pics)
            pics = pics + 1
        End If
    Next
    
    If pics > 1 Then
        Open TempDir & "\attachments.html" For Output As #1
        Print #1, "<HTML><BODY>"
        For i = 1 To pics - 1
            Print #1, "<IMG src=""Image" & VBA.Format(Application.ActiveExplorer.Selection.Item(1).ReceivedTime, "_ddmmmyyyy_hhmm_") & i & """ /><HR/>"
        Next
        Print #1, "</BODY></HTML>"
        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

    Dim ext3 As String
    Dim ext4 As String

    ext3 = VBA.UCase(VBA.Right(filename, 4))
    ext4 = VBA.UCase(VBA.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 & "\Image*."
End Sub