嘗試運行宏時遇到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