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
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
)