マクロを実行しようとしたときにOutlook-vbaタイプの不一致エラーが発生しました

Question

以下のコードを実行しようとすると、「タイプが一致しません」というエラーが表示されます。

マイコードは、さまざまな受信者からの受信メールを特定の場所の.txtファイルとして保存するために使用します。

コンピュータが再起動され、再起動する前に問題なく実行できました。

何が問題になりますか？

Sub SaveEmail(msg As Outlook.MailItem) 
    ' save as text 
    If InStr(msg.Subject, "OBW cell status") > 0 Then 
    msg.SaveAs "C:\Users\emirmot\Desktop\Tag Tool\obw\email" & Format(msg.CreationTime, "YYYYMMDDHHMMSS") & ".txt", olTXT 
    End If 

    If InStr(msg.Subject, "Yoigo Cells Down Report") > 0 Then 
    msg.SaveAs "C:\Users\emirmot\Desktop\Tag Tool\yoigo\email" & Format(msg.CreationTime, "YYYYMMDDHHMMSS") & ".txt", olTXT 
    End If 

    If InStr(msg.Subject, "KPN 3G") > 0 Then 
    msg.SaveAs "C:\Users\emirmot\Desktop\Tag Tool\kpn\3gemail" & Format(msg.CreationTime, "YYYYMMDDHHMMSS") & ".txt", olTXT 
    End If 

    If InStr(msg.Subject, "KPN 2G") > 0 Then 
    msg.SaveAs "C:\Users\emirmot\Desktop\Tag Tool\kpn\2gemail" & Format(msg.CreationTime, "YYYYMMDDHHMMSS") & ".txt", olTXT 
    End If 

    If InStr(msg.Subject, "KPN 4G") > 0 Then 
    msg.SaveAs "C:\Users\emirmot\Desktop\Tag Tool\kpn\4gemail" & Format(msg.CreationTime, "YYYYMMDDHHMMSS") & ".txt", olTXT 
    End If 

    If InStr(msg.Sender, "GAUSS.ADMIN@dcn.h3g.it") > 0 Then 
    msg.SaveAs "C:\Users\emirmot\Desktop\Tag Tool\h3g\gauss\" & Replace(msg.Subject, ":", "") & ".txt", olTXT 
    End If 

    Dim objAtt As Outlook.Attachment 
    Dim saveFolder As String 
    saveFolder = "C:\Users\emirmot\Desktop\Tag Tool\h3g\" 

    Dim saveFoldersiu As String 
    saveFoldersiu = "C:\Users\emirmot\Desktop\Tag Tool\yoigo\siu\" 

    Dim saveFoldernodata As String 
    saveFoldernodata = "C:\Users\emirmot\Desktop\Tag Tool\yoigo\" 

    Dim saveFoldermobistar As String 
    saveFoldermobistar = "C:\Users\emirmot\Desktop\Tag Tool\mobistar\" 

    Dim saveFolderip_sa_tools As String 
    saveFolderip_sa_tools = "C:\Users\emirmot\Desktop\Tag Tool\yoigo\ip_sa_tools\" 

    Dim saveFolder_yoigoreport As String 
    saveFolder_yoigoreport = "C:\wamp\www\cell_avail_report\uploads\" 

    Dim saveFolder_h3gtn As String 
    saveFolder_h3gtn = "C:\Users\emirmot\Desktop\Tag Tool\h3g\tn_temp\" 

    If InStr(msg.Subject, "H3G IT") > 0 Then 
    For Each objAtt In msg.Attachments 
      objAtt.SaveAsFile saveFolder & "\" & Format(msg.ReceivedTime, "YYYYMMDDHHMMSS") & objAtt.DisplayName 
      Set objAtt = Nothing 
    Next 
    End If 

    If InStr(msg.Subject, "All RNC Hourly Iublink State") > 0 Then 
    For Each objAtt In msg.Attachments 
      objAtt.SaveAsFile saveFoldernodata & "\" & Format(msg.ReceivedTime, "YYYYMMDDHHMMSS") & objAtt.DisplayName 
      Set objAtt = Nothing 
    Next 
    End If 

    If InStr(msg.Subject, "SIU") > 0 Then 
    For Each objAtt In msg.Attachments 
      objAtt.SaveAsFile saveFoldersiu & "\" & objAtt.DisplayName 
      Set objAtt = Nothing 
    Next 
    End If 

    If InStr(msg.Subject, "CELLS STATUS") > 0 Then 
    For Each objAtt In msg.Attachments 
      objAtt.SaveAsFile saveFoldermobistar & "\" & Format(msg.ReceivedTime, "YYYYMMDDHHMMSS") & objAtt.DisplayName 
      Set objAtt = Nothing 
    Next 
    End If 

    If InStr(msg.Subject, "OneFM Alarms - Generic message") > 0 Then 
    For Each objAtt In msg.Attachments 
      objAtt.SaveAsFile saveFolderip_sa_tools & "\" & Format(msg.ReceivedTime, "YYYYMMDDHHMMSS") & objAtt.DisplayName 
      Set objAtt = Nothing 
    Next 
    End If 

    If InStr(msg.Sender, "bis4g@report.com") > 0 Then 
    For Each objAtt In msg.Attachments 
      objAtt.SaveAsFile saveFolder_yoigoreport & "\" & objAtt.DisplayName 
      Set objAtt = Nothing 
    Next 
    End If 

    If InStr(msg.Sender, "eradior@miuo1adm2.dns.miuoss") > 0 Then 
    For Each objAtt In msg.Attachments 
      objAtt.SaveAsFile saveFolder_h3gtn & "\" & objAtt.DisplayName 
      Set objAtt = Nothing 
    Next 
    End If 

End Sub 

Sub TestSaveEmail() 
    Call SaveEmail(ActiveExplorer.Application) 
End Sub 

Answer 1

これは問題である可能性があります。 MailItemオブジェクトが必要なときに、アプリケーションオブジェクトをSaveEmailサブに渡しています。 ActiveExplorer.ApplicationではなくSaveEmailプロシージャにメッセージを渡してみてください。

Sub SaveEmail(msg As Outlook.MailItem) 

Call SaveEmail(ActiveExplorer.Application) 

Answer 2

Jガースが正しくあなたがTestSaveEmailを実行しようとした場合には遭遇するであろうが、訂正を提供していない最初のエラーを識別します。 Explorerを使ってみましたか？もしそうなら、これを試してください：あなたのコードは、別のエラーが発生した

Sub TestSaveEmail() 
    Dim Exp As Outlook.Explorer 
    Dim ItemCrnt As MailItem 

    If Exp.Selection.Count = 0 Then 
    Debug.Print "No emails selected" 
    Else 
    For Each ItemCrnt In Exp.Selection 
     Call SaveEmail(ItemCrnt) 
    Next 
    End If 
End Sub 

場合は、R3uKさんのコメントを読んで、エラーを与える行を教えする必要があります。

Sub TestSaveEmail() 
    Dim Exp As Outlook.Explorer 

    If Exp.Selection.Count = 0 Then 
    Debug.Print "No emails selected" 
    Else 
    Call SaveEmail(Exp.Selection(1)) 
    Next 
    End If 
End Sub