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:\Folder1\Folder2\"

    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对象以外的其他内容，则行Set olMi = Fldr.Items(I)会导致类型不匹配，例如ReportItem或MeetingItem。将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

错误VBA“将电子邮件的附件文件保存在文件夹中”

2 个答案: