Fehler VBA "Speichern der Anhangsdatei einer E-Mail in einem Ordner"

Question

Ich versuche ein Makro zu erstellen, um eine Anlagedatei von einer E-Mail in einem Ordner zu speichern. Aber es zeigt mir einen Fehler '13' (Typ stimmt nicht überein). Ich suche nach einer Antwort, aber ohne Erfolg.

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

Die Linie Set olMi = Fldr.Items(I) einen Typenkonflikt verursachen, wenn Sie etwas anderes als ein MailItem Objekt, wie ReportItem oder MeetingItem haben. Deklarieren Sie olMi als generisches Objekt.

Denken Sie auch daran, dass in einem Ordner durch alle Elemente Looping ist eine schreckliche Idee - verwenden Items.Restrict oder Items.Find/FindNext

UPDATE: Suche nach 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

Dieses es beheben sollte, geben Sie es versuchen ...

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