Question

我遇到了＆＃34;类型不匹配＆＃34;尝试运行下面的代码时弹出错误。

我的代码用于将来自各种收件人的传入电子邮件保存为给定位置的.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

J Garth正确识别了您尝试运行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

Answer 2

这可能是个问题。您正在期望MailItem对象时将应用程序对象传递给SaveEmail子对象。尝试将消息传递给SaveEmail过程而不是ActiveExplorer.Application。

Sub SaveEmail(msg As Outlook.MailItem)

Call SaveEmail(ActiveExplorer.Application)

尝试运行宏时遇到Outlook-vba类型不匹配错误

2 个答案: