错误 VBA "Saving a e-mail's attachment file in a folder"

Question

我正在尝试执行一个宏，将电子邮件中的附件文件保存到文件夹中。但它显示了一个错误"13"（类型不匹配）。我正在寻找答案，但没有成功。

    Sub Arquivosanexos()
    Dim oltApp As Outlook.Application
    Dim olNs As Namespace
    Dim Fldr As MAPIFolder
    Dim MoveToFldr As MAPIFolder
    Dim olMi As MailItem
    Dim olAtt As Attachment
    Dim MyPath As String
    Dim I As Long

    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
    Set MoveToFldr = Fldr.Folders("TEST")
    MyPath = "C:Folder1Folder2"
    For I = Fldr.Items.Count To 1 Step -1
            Set olMi = Fldr.Items(I)
'Procura pelo nome do email
        If InStr(1, olMi.Subject, "Sample of e-mail's name") > 0 Then
            For Each olAtt In olMi.Attachments
'Procura pelo nome do arquivo
             If InStr(1, olAtt.FileName, "Sample of attachment's name") Then
             olAtt.SaveAsFile MyPath & ".xlsx"
             End If
            Next olAtt
            olMi.Save
            olMi.Move MoveToFldr
        End If
    Next I
    Set olAtt = Nothing
    Set olMi = Nothing
    Set Fldr = Nothing
    Set MoveToFldr = Nothing
    Set olNs = Nothing
    Set olApp = Nothing
End Sub

Answer 1

如果您有MailItem对象以外的其他对象，例如ReportItem或MeetingItem，则行Set olMi = Fldr.Items(I)将导致类型不匹配。将olMi声明为泛型对象。

还要记住，循环浏览文件夹中的所有项目是一个糟糕的想法——使用Items.Restrict或Items.Find/FindNext

更新：搜索PR_CONVERSATION_TOPIC:

set restrItems = Fldr.Item.Restrict("SQL=""http://schemas.microsoft.com/mapi/proptag/0x0070001F"" LIKE '%Sample of e-mail''s name%' ")

Answer 2

这应该会修复它，请尝试。。。

Option Explicit
Sub Arquivosanexos()
    Dim olNs As Outlook.NameSpace
    Dim Inbox As MAPIFolder
    Dim SubFolder As MAPIFolder
    Dim Item As Outlook.MailItem
    Dim Atmt As Outlook.Attachment
    Dim FilePath As String
    Dim i As Long
    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set SubFolder = Inbox.Folders("Temp")
    FilePath = "C:Temp"
    For i = Inbox.Items.Count To 1 Step -1
        Set Item = Inbox.Items(i)
        If InStr(1, Item.Subject, "Sample of e-mails name") > 0 Then
            For Each Atmt In Item.Attachments
                If Atmt.FileName = "Sample of attachments name.xlsx" Then
                    Atmt.SaveAsFile FilePath & Item.SenderName & ".xlsx"
                End If
            Next Atmt
            Item.Move SubFolder
        End If
    Next i
    Set olNs = Nothing
    Set Inbox = Nothing
    Set SubFolder = Nothing
    Set Item = Nothing
    Set Atmt = Nothing
End Sub