Runtime error 91 Outlook Save Attchments

Question

Runtime error 91 -Object Variable or With Block variable not set

I'm getting Error 91
I am trying to save attachment as they arrive and then move it to sub-folder then print.

I am using the code on ThisOutlookSession

Private Sub SaveMovePrint(olMail As Outlook.MailItem)
    'On Error Resume Next
    Dim colAtts As Outlook.Attachments
    Dim olAtt As Outlook.Attachment
    Dim olFile As String
    Dim olDirectory As String
    Dim olFileType As String
    Dim olNameSpace As Outlook.NameSpace
    Dim olInbox As Outlook.Folder
    Dim olDestFolder As Outlook.Folder
    Dim olItems As Outlook.Items
    Dim olItem As Object

this line is where the Error is coming from Set colAtts = olAtt.Attachments

    Set colAtts = olAtt.Attachments
    Set olNameSpace = Application.GetNamespace("MAPI")
    Set olInbox = olNameSpace.GetDefaultFolder(olFolderInbox)
    Set olItems = olInbox.Items

    '// Save attachment then move
    If colAtts.Count Then

        '// Select Case save attch move
        Select Case olMail.SenderEmailAddress
            '// One
            Case "FaxOne@one.com"
                '// Save it to
                olDirectory = "C:\Users\Documents\FaxOne\"
                '// Move email to subfolder
                Set olDestFolder = olInbox.Folders("FaxOne")
                Set olItem = olItems.Find("[SenderName] = FaxOne@one.com'")
                While TypeName(olItem) <> "Nothing"
                    olItem.Move olDestFolder
                Set olItem = olItems.FindNext
                Wend

            '// Two
            Case "FaxTwo@two.com"
                '// Save attachments to
                olDirectory = "C:\Users\Documents\FaxTwo\" 
                Set olDestFolder = olInbox.Folders("FaxTwo")
                Set olItem = olItems.Find("[SenderName] = 'FaxTwo@two.com'")
                While TypeName(olItem) <> "Nothing"
                    olItem.Move olDestFolder
                Set olItem = olItems.FindNext
                Wend
            Case Else: Exit Sub
        End Select

        For Each olAtt In colAtts

            '// The code looks last 4 characters,
            '// including period and will work as long
            '// as you use 4 characters in each extension.
            olFileType = LCase$(Right$(olAtt.FileName, 4))

            '// Select Case File & Print
            Select Case olFileType

                '// Add additional file types below
                Case "docx", ".pdf", ".doc"

                olFile = olDirectory & olAtt.FileName
                olAtt.SaveAsFile olFile

                '// to print attachements
                ShellExecute 0, "print", olFile, vbNullString, vbNullString, 0
            End Select
        Next
    End If
End Sub

Answer 1

The olAtt object is declared, but not initialized in the code. You need to use the olMail object instead in the code:

Private Sub SaveMovePrint(olMail As Outlook.MailItem)
    'On Error Resume Next
    Dim colAtts As Outlook.Attachments
    Dim olFile As String
    Dim olDirectory As String
    Dim olFileType As String
    Dim olNameSpace As Outlook.NameSpace
    Dim olInbox As Outlook.Folder
    Dim olDestFolder As Outlook.Folder
    Dim olItems As Outlook.Items
    Dim olItem As Object

    Set colAtts = olMail.Attachments
    Set olNameSpace = Application.GetNamespace("MAPI")
    Set olInbox = olNameSpace.GetDefaultFolder(olFolderInbox)
    Set olItems = olInbox.Items

    '// Save attachment then move
    If colAtts.Count Then

        '// Select Case save attch move
        Select Case olMail.SenderEmailAddress
            '// One
            Case "FaxOne@one.com"
                '// Save it to
                olDirectory = "C:\Users\Documents\FaxOne\"
                '// Move email to subfolder
                Set olDestFolder = olInbox.Folders("FaxOne")
                Set olItem = olItems.Find("[SenderName] = FaxOne@one.com'")
                While TypeName(olItem) <> "Nothing"
                    olItem.Move olDestFolder
                Set olItem = olItems.FindNext
                Wend

            '// Two
            Case "FaxTwo@two.com"
                '// Save attachments to
                olDirectory = "C:\Users\Documents\FaxTwo\" 
                Set olDestFolder = olInbox.Folders("FaxTwo")
                Set olItem = olItems.Find("[SenderName] = 'FaxTwo@two.com'")
                While TypeName(olItem) <> "Nothing"
                    olItem.Move olDestFolder
                Set olItem = olItems.FindNext
                Wend
            Case Else: Exit Sub
        End Select

        For Each olAtt In colAtts

            '// The code looks last 4 characters,
            '// including period and will work as long
            '// as you use 4 characters in each extension.
            olFileType = LCase$(Right$(olAtt.FileName, 4))

            '// Select Case File & Print
            Select Case olFileType

                '// Add additional file types below
                Case "docx", ".pdf", ".doc"

                olFile = olDirectory & olAtt.FileName
                olAtt.SaveAsFile olFile

                '// to print attachements
                ShellExecute 0, "print", olFile, vbNullString, vbNullString, 0
            End Select
        Next
    End If
End Sub