尝试运行宏时遇到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子项。尝试将消息传递给SaveEmail过程而不是ActiveExplorer.Application。

Sub SaveEmail(msg As Outlook.MailItem) 

Call SaveEmail(ActiveExplorer.Application) 

Answer 2

Ĵ加思正确识别，如果你试图运行TestSaveEmail会遇到，但不提供修正的第一个错误。你是否试图使用资源管理器？如果是的话，试试这个：

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