Type Mismatch error返回邮件项目的属性。

huangapple
go评论93阅读模式
英文:

Type Mismatch error returning mailitem property from an item

问题

我有以下的代码。

我收到

运行时错误 13 类型不匹配

在 objMail.ReceivedTime 处。

我尝试了 On Error Resume Next。

  1. Sub ExportAttachmentsLastWeek()
  2.     Dim objOL As Outlook.Application
  3.     Dim objNS As Outlook.NameSpace
  4.     Dim objFolder As Outlook.Folder
  5.     Dim objMail As Outlook.MailItem
  6.     Dim objAttachment As Outlook.Attachment
  7.     Dim strFolderPath As String
  8.     Dim strFileName As String
  9.     Dim dtmCriteria As Date
  11.     Set objOL = CreateObject("Outlook.Application")
  12.     Set objNS = objOL.GetNamespace("MAPI")
  13.     Set objFolder = objNS.PickFolder
  15.     If objFolder Is Nothing Then
  16.         Exit Sub
  17.     End If
  19.     strFolderPath = "C:\Users\evansj01\Documents\"
  21.    ' 计算一周前的日期
  22.     dtmCriteria = Now() - 7
  23.     
  24.     For Each objMail In objFolder.Items
  25.         ' 检查电子邮件接收日期是否在上周内
  26.         If objMail.ReceivedTime >= dtmCriteria Then
  27.             If objMail.Attachments.Count > 0 Then
  28.                 For Each objAttachment In objMail.Attachments
  29.                     If Right(objAttachment.FileName, 3) = "xls" Then ' 根据需要更改文件格式
  30.                         strFileName = strFolderPath & objMail.Subject & "_" & objAttachment.FileName
  31.                         objAttachment.SaveAsFile strFileName
  32.                     End If
  33.                 Next
  34.             End If
  35.         End If
  36.     Next
  37.     
  38.     Set objAttachment = Nothing
  39.     Set objMail = Nothing
  40.     Set objFolder = Nothing
  41.     Set objNS = Nothing
  42.     Set objOL = Nothing
  43. End Sub

我希望它能下载在该时间段内接收到的所有Excel文件到所选文件夹中。

英文:

I have this code below.

I get

>runtime error 13 type mismatch

at objMail.ReceivedTime.

I tried On Error Resume Next.

  1. Sub ExportAttachmentsLastWeek()
  2.     Dim objOL As Outlook.Application
  3.     Dim objNS As Outlook.NameSpace
  4.     Dim objFolder As Outlook.Folder
  5.     Dim objMail As Outlook.MailItem
  6.     Dim objAttachment As Outlook.Attachment
  7.     Dim strFolderPath As String
  8.     Dim strFileName As String
  9.     Dim dtmCriteria As Date
  11.     Set objOL = CreateObject("Outlook.Application")
  12.     Set objNS = objOL.GetNamespace("MAPI")
  13.     Set objFolder = objNS.PickFolder
  15.     If objFolder Is Nothing Then
  16.         Exit Sub
  17.     End If
  19.     strFolderPath = "C:\Users\evansj01\Documents\"
  20.   
  21.    'Calculate date 1 week ago
  22.     dtmCriteria = Now() - 7
  23.     
  24.     For Each objMail In objFolder.Items
  25.         'Check if the email received date is within the last week
  26.         If objMail.ReceivedTime >= dtmCriteria Then
  27.             If objMail.Attachments.Count > 0 Then
  28.                 For Each objAttachment In objMail.Attachments
  29.                     If Right(objAttachment.FileName, 3) = "xls" Then 'change file format as needed
  30.                         strFileName = strFolderPath & objMail.Subject & "_" & objAttachment.FileName
  31.                         objAttachment.SaveAsFile strFileName
  32.                     End If
  33.                 Next
  34.             End If
  35.         End If
  36.     Next
  37.     
  38.     Set objAttachment = Nothing
  39.     Set objMail = Nothing
  40.     Set objFolder = Nothing
  41.     Set objNS = Nothing
  42.     Set objOL = Nothing
  43. End Sub

I was hoping it would download all Excel files received in that time period to the folder selected.

答案1

得分: 2

尝试这个（从您的代码中有两处更改，都已注释）：

  1. Sub ExportAttachmentsLastWeek()
  2.     Dim objOL As Outlook.Application
  3.     Dim objNS As Outlook.NameSpace
  4.     Dim objFolder As Outlook.Folder
  5.     Dim objMail As Object ' changed from Outlook.MailItem
  6.     Dim objAttachment As Outlook.Attachment
  7.     Dim strFolderPath As String
  8.     Dim strFileName As String
  9.     Dim dtmCriteria As Date
  11.     Set objOL = CreateObject("Outlook.Application")
  12.     Set objNS = objOL.GetNamespace("MAPI")
  13.     Set objFolder = objNS.PickFolder
  15.     If objFolder Is Nothing Then
  16.         Exit Sub
  17.     End If
  19.     strFolderPath = "C:\Users\evansj01\Documents\"
  21.     ' 计算一周前的日期
  22.     dtmCriteria = Now() - 7
  24.     For Each objMail In objFolder.Items
  25.         ' 针对项目类型进行额外测试
  26.         If TypeOf objMail Is MailItem Then
  27.             ' 检查电子邮件接收日期是否在上周内
  28.             If objMail.ReceivedTime >= dtmCriteria Then
  29.                 If objMail.Attachments.Count > 0 Then
  30.                     For Each objAttachment In objMail.Attachments
  31.                         If Right(objAttachment.FileName, 3) = "xls" Then ' 根据需要更改文件格式
  32.                             strFileName = strFolderPath & objMail.Subject & "_" & objAttachment.FileName
  33.                             objAttachment.SaveAsFile strFileName
  34.                         End If
  35.                     Next
  36.                 End If
  37.             End If
  38.         End If
  39.     Next
  41.     Set objAttachment = Nothing
  42.     Set objMail = Nothing
  43.     Set objFolder = Nothing
  44.     Set objNS = Nothing
  45.     Set objOL = Nothing
  46. End Sub

请注意，这是您提供的VBA代码的中文翻译。如果您需要进一步的帮助或解释，请告诉我。

英文:

Try this (two changes from your code, both commented):

  1. Sub ExportAttachmentsLastWeek()
  2.     Dim objOL As Outlook.Application
  3.     Dim objNS As Outlook.NameSpace
  4.     Dim objFolder As Outlook.Folder
  5.     Dim objMail As Object ' changed from Outlook.MailItem
  6.     Dim objAttachment As Outlook.Attachment
  7.     Dim strFolderPath As String
  8.     Dim strFileName As String
  9.     Dim dtmCriteria As Date
  11.     Set objOL = CreateObject("Outlook.Application")
  12.     Set objNS = objOL.GetNamespace("MAPI")
  13.     Set objFolder = objNS.PickFolder
  15.     If objFolder Is Nothing Then
  16.         Exit Sub
  17.     End If
  19.     strFolderPath = "C:\Users\evansj01\Documents\"
  20.   
  21.    'Calculate date 1 week ago
  22.     dtmCriteria = Now() - 7
  23.     
  24.     For Each objMail In objFolder.Items
  25.         ' additional test for type of item
  26.         If TypeOf objMail Is MailItem Then
  27.             'Check if the email received date is within the last week
  28.             If objMail.ReceivedTime >= dtmCriteria Then
  29.                 If objMail.Attachments.Count > 0 Then
  30.                     For Each objAttachment In objMail.Attachments
  31.                         If Right(objAttachment.FileName, 3) = "xls" Then 'change file format as needed
  32.                             strFileName = strFolderPath & objMail.Subject & "_" & objAttachment.FileName
  33.                             objAttachment.SaveAsFile strFileName
  34.                         End If
  35.                     Next
  36.                 End If
  37.             End If
  38.         End If
  39.     Next
  40.     
  41.     Set objAttachment = Nothing
  42.     Set objMail = Nothing
  43.     Set objFolder = Nothing
  44.     Set objNS = Nothing
  45.     Set objOL = Nothing
  46. End Sub

huangapple
  • 本文由 发表于 2023年6月26日 19:23:34
  • 转载请务必保留本文链接：https://go.coder-hub.com/76556210.html
  • excel
  • outlook
  • vba
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定