Search code examples
outlookruntime-errortype-mismatch

Outlook automation to move emails - run time error 13


I would like to automate my MS Outlook inbox. The idea is to move all emails (i) with a specific sender address and (ii) older than 7 days as of today into a subfolder to my inbox. Please see working example below (you may need to adjust folder names so it works on you machine).

My problem: after 88 iterations I run into a "run time error 13, type mismatch". Why does this happen after so many iterations? And, more importantly, how to fix it? Any ideas?

All default libraries are enabled on my VBE. I am using MS Office 2019.

Thank you!


    '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

Solution

  • Your code assumes that you can only have MailItem objects in the Inbox folder. You an also have ReportItem and MeetingItem objects.

    Declare objMail as a generic Object and in the loop check first that the Class property is 43 (OlObjectClass.olMail)