英文:
Type Mismatch error returning mailitem property from an item
问题
我有以下的代码。
我收到
运行时错误 13 类型不匹配
在 objMail.ReceivedTime 处。
我尝试了 On Error Resume Next。
Sub ExportAttachmentsLastWeek()
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.Folder
Dim objMail As Outlook.MailItem
Dim objAttachment As Outlook.Attachment
Dim strFolderPath As String
Dim strFileName As String
Dim dtmCriteria As Date
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If objFolder Is Nothing Then
Exit Sub
End If
strFolderPath = "C:\Users\evansj01\Documents\"
' 计算一周前的日期
dtmCriteria = Now() - 7
For Each objMail In objFolder.Items
' 检查电子邮件接收日期是否在上周内
If objMail.ReceivedTime >= dtmCriteria Then
If objMail.Attachments.Count > 0 Then
For Each objAttachment In objMail.Attachments
If Right(objAttachment.FileName, 3) = "xls" Then ' 根据需要更改文件格式
strFileName = strFolderPath & objMail.Subject & "_" & objAttachment.FileName
objAttachment.SaveAsFile strFileName
End If
Next
End If
End If
Next
Set objAttachment = Nothing
Set objMail = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set objOL = Nothing
End Sub
我希望它能下载在该时间段内接收到的所有Excel文件到所选文件夹中。
英文:
I have this code below.
I get
>runtime error 13 type mismatch
at objMail.ReceivedTime.
I tried On Error Resume Next.
Sub ExportAttachmentsLastWeek()
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.Folder
Dim objMail As Outlook.MailItem
Dim objAttachment As Outlook.Attachment
Dim strFolderPath As String
Dim strFileName As String
Dim dtmCriteria As Date
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If objFolder Is Nothing Then
Exit Sub
End If
strFolderPath = "C:\Users\evansj01\Documents\"
'Calculate date 1 week ago
dtmCriteria = Now() - 7
For Each objMail In objFolder.Items
'Check if the email received date is within the last week
If objMail.ReceivedTime >= dtmCriteria Then
If objMail.Attachments.Count > 0 Then
For Each objAttachment In objMail.Attachments
If Right(objAttachment.FileName, 3) = "xls" Then 'change file format as needed
strFileName = strFolderPath & objMail.Subject & "_" & objAttachment.FileName
objAttachment.SaveAsFile strFileName
End If
Next
End If
End If
Next
Set objAttachment = Nothing
Set objMail = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set objOL = Nothing
End Sub
I was hoping it would download all Excel files received in that time period to the folder selected.
答案1
得分: 2
尝试这个（从您的代码中有两处更改，都已注释）：
Sub ExportAttachmentsLastWeek()
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.Folder
Dim objMail As Object ' changed from Outlook.MailItem
Dim objAttachment As Outlook.Attachment
Dim strFolderPath As String
Dim strFileName As String
Dim dtmCriteria As Date
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If objFolder Is Nothing Then
Exit Sub
End If
strFolderPath = "C:\Users\evansj01\Documents\"
' 计算一周前的日期
dtmCriteria = Now() - 7
For Each objMail In objFolder.Items
' 针对项目类型进行额外测试
If TypeOf objMail Is MailItem Then
' 检查电子邮件接收日期是否在上周内
If objMail.ReceivedTime >= dtmCriteria Then
If objMail.Attachments.Count > 0 Then
For Each objAttachment In objMail.Attachments
If Right(objAttachment.FileName, 3) = "xls" Then ' 根据需要更改文件格式
strFileName = strFolderPath & objMail.Subject & "_" & objAttachment.FileName
objAttachment.SaveAsFile strFileName
End If
Next
End If
End If
End If
Next
Set objAttachment = Nothing
Set objMail = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set objOL = Nothing
End Sub
请注意，这是您提供的VBA代码的中文翻译。如果您需要进一步的帮助或解释，请告诉我。
英文:
Try this (two changes from your code, both commented):
Sub ExportAttachmentsLastWeek()
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.Folder
Dim objMail As Object ' changed from Outlook.MailItem
Dim objAttachment As Outlook.Attachment
Dim strFolderPath As String
Dim strFileName As String
Dim dtmCriteria As Date
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If objFolder Is Nothing Then
Exit Sub
End If
strFolderPath = "C:\Users\evansj01\Documents\"
'Calculate date 1 week ago
dtmCriteria = Now() - 7
For Each objMail In objFolder.Items
' additional test for type of item
If TypeOf objMail Is MailItem Then
'Check if the email received date is within the last week
If objMail.ReceivedTime >= dtmCriteria Then
If objMail.Attachments.Count > 0 Then
For Each objAttachment In objMail.Attachments
If Right(objAttachment.FileName, 3) = "xls" Then 'change file format as needed
strFileName = strFolderPath & objMail.Subject & "_" & objAttachment.FileName
objAttachment.SaveAsFile strFileName
End If
Next
End If
End If
End If
Next
Set objAttachment = Nothing
Set objMail = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set objOL = Nothing
End Sub
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论