エラーVBA "フォルダに電子メールの添付ファイルを保存する"

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

UPDATE使用：それは試してみる、

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

Answer 2

これはそれを修正する必要がありますPR_CONVERSATION_TOPICの検索を...

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