用于移动电子邮件的 Outlook 自动化 - 运行 时间错误 13
Outlook automation to move emails - run time error 13
我想自动化我的 MS Outlook 收件箱。我的想法是将所有电子邮件 (i) 具有特定发件人地址和 (ii) 从今天起超过 7 天的时间移动到我收件箱的子文件夹中。请参阅下面的工作示例(您可能需要调整文件夹名称以使其在您的机器上运行)。
我的问题:在 88 次迭代后我 运行 变成了“运行 时间错误 13,类型不匹配”。为什么经过这么多次迭代后会发生这种情况?而且,更重要的是,如何修复它?有什么想法吗?
我的 VBE 上启用了所有默认库。我正在使用 MS Office 2019。
谢谢!
'On Error Resume Next
On Error GoTo 0
'-----------------------------------------------------------------------------------------
' declare variables
'-----------------------------------------------------------------------------------------
Dim objSourceFolder As MAPIFolder
Dim objDestinationFolder As MAPIFolder
Dim objMail As MailItem ' single email
Dim objMails As Items ' all emails in source folder
Dim lngItems As Long ' number of checked emails
Dim intDays As Integer ' number of days
Dim counter As Integer ' number of moved emails
'-----------------------------------------------------------------------------------------
' email age in days
'-----------------------------------------------------------------------------------------
intDays = 7
'-----------------------------------------------------------------------------------------
' define folder (= inbox)
'-----------------------------------------------------------------------------------------
Set objSourceFolder = GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
'-----------------------------------------------------------------------------------------
' reference items in source folder
'-----------------------------------------------------------------------------------------
Set objMails = objSourceFolder.Items
'objMails.Count
'-----------------------------------------------------------------------------------------
' sort emails in source folder (oldest first)
'-----------------------------------------------------------------------------------------
objMails.Sort "ReceivedTime", False
'-----------------------------------------------------------------------------------------
' move email
'-----------------------------------------------------------------------------------------
For Each objMail In objMails
If objMail.ReceivedTime < Now - intDays Then
Select Case objMail.SenderEmailAddress
Case "mailrobot@mail.xing.com":
Set objDestinationFolder = GetNamespace("Mapi").Folders(1).Folders("Inbox").Folders("Xing")
End Select
If objDestinationFolder Is Nothing Then
Else: objMail.Move objDestinationFolder
counter = counter + 1
End If
lngItems = lngItems + 1
End If
Next
End Sub
您的代码假定收件箱文件夹中只能有 MailItem
个对象。您还有 ReportItem
和 MeetingItem
个对象。
将 objMail
声明为通用对象,并在循环中首先检查 Class
属性 是否为 43 (OlObjectClass.olMail
)
我想自动化我的 MS Outlook 收件箱。我的想法是将所有电子邮件 (i) 具有特定发件人地址和 (ii) 从今天起超过 7 天的时间移动到我收件箱的子文件夹中。请参阅下面的工作示例(您可能需要调整文件夹名称以使其在您的机器上运行)。
我的问题:在 88 次迭代后我 运行 变成了“运行 时间错误 13,类型不匹配”。为什么经过这么多次迭代后会发生这种情况?而且,更重要的是,如何修复它?有什么想法吗?
我的 VBE 上启用了所有默认库。我正在使用 MS Office 2019。
谢谢!
'On Error Resume Next
On Error GoTo 0
'-----------------------------------------------------------------------------------------
' declare variables
'-----------------------------------------------------------------------------------------
Dim objSourceFolder As MAPIFolder
Dim objDestinationFolder As MAPIFolder
Dim objMail As MailItem ' single email
Dim objMails As Items ' all emails in source folder
Dim lngItems As Long ' number of checked emails
Dim intDays As Integer ' number of days
Dim counter As Integer ' number of moved emails
'-----------------------------------------------------------------------------------------
' email age in days
'-----------------------------------------------------------------------------------------
intDays = 7
'-----------------------------------------------------------------------------------------
' define folder (= inbox)
'-----------------------------------------------------------------------------------------
Set objSourceFolder = GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
'-----------------------------------------------------------------------------------------
' reference items in source folder
'-----------------------------------------------------------------------------------------
Set objMails = objSourceFolder.Items
'objMails.Count
'-----------------------------------------------------------------------------------------
' sort emails in source folder (oldest first)
'-----------------------------------------------------------------------------------------
objMails.Sort "ReceivedTime", False
'-----------------------------------------------------------------------------------------
' move email
'-----------------------------------------------------------------------------------------
For Each objMail In objMails
If objMail.ReceivedTime < Now - intDays Then
Select Case objMail.SenderEmailAddress
Case "mailrobot@mail.xing.com":
Set objDestinationFolder = GetNamespace("Mapi").Folders(1).Folders("Inbox").Folders("Xing")
End Select
If objDestinationFolder Is Nothing Then
Else: objMail.Move objDestinationFolder
counter = counter + 1
End If
lngItems = lngItems + 1
End If
Next
End Sub
您的代码假定收件箱文件夹中只能有 MailItem
个对象。您还有 ReportItem
和 MeetingItem
个对象。
将 objMail
声明为通用对象,并在循环中首先检查 Class
属性 是否为 43 (OlObjectClass.olMail
)