Outlook-VBA Typ Mismatch-Fehler beim Versuch, Makro auszuführen

Question

Ich begegne dem "Typ nicht übereinstimmen" Popup-Fehler beim Versuch, den folgenden Code auszuführen.

Mein Code wird verwendet, um eingehende E-Mails von verschiedenen Empfängern als TXT-Dateien an einem bestimmten Speicherort zu speichern.

Der Computer wurde neu gestartet und vor dem Neustart konnte ich ohne Probleme ausführen.

Was kann das Problem sein?

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

Dies könnte das Problem sein. Sie übergeben ein Anwendungsobjekt an die SaveEmail-Sub, wenn es ein MailItem-Objekt erwartet. Versuchen Sie, anstelle von ActiveExplorer.Application eine Nachricht an die SaveEmail-Prozedur zu senden.

Sub SaveEmail(msg As Outlook.MailItem) 

Call SaveEmail(ActiveExplorer.Application) 

Answer 2

J Garth korrekt identifiziert den ersten Fehler, die auftreten würden, wenn Sie versuchen, TestSaveEmail zu laufen, aber keine Korrektur bieten. Haben Sie versucht, Explorer zu verwenden? Wenn ja, versuchen Sie dies:

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 

Wenn Ihr Code einen anderen Fehler auftritt, müssen Sie R3uK Kommentar und sagen Sie uns, welche Zeile gibt den Fehler lesen.

von meinem Kommentar Aktualisiert

Sie sollten mindestens eine Postsendung ausgewählt prüfen, ob sich aber, wenn Sie wirklich nur eine E-Mail speichern möchten, gehen Sie folgendermaßen vor:

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