时间戳

首页 > 解决方案 > Outlook 自动化移动电子邮件 - 运行时错误 13

outlook - Outlook 自动化移动电子邮件 - 运行时错误 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

标签： outlookruntime-errortype-mismatch

解决方案

您的代码假定您只能MailItem在收件箱文件夹中有对象。你也有ReportItem和MeetingItem对象。

声明objMail为通用对象并在循环中首先检查Class属性是否为 43 ( OlObjectClass.olMail)

推荐阅读