运行时错误91 Outlook保存附件

Question

  

    

运行时错误91-对象变量或未设置块变量

  

我收到错误91
我试图在附件到达时保存附件，然后将其移动到子文件夹然后打印。

我正在使用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

这一行是错误来自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

声明olAtt对象，但未在代码中初始化。您需要在代码中使用olMail对象：

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