vbaoutlook

Move mailItem based on keyword in body


I'm attempting to move emails coming to my main inbox (for testing, future second inbox) be routed to a subfolder. I want it to activate on all items on receipt.

The line

Item.Move olnamespace.Folders("My Name").Folders("Inbox").Folders("Subfolder")

fails with

run-time error 91

Private WithEvents secondinboxitems As Outlook.Items

Sub initializesecondinboxitems()
Dim olapp As Outlook.Application
Dim olnamespace As Outlook.NameSpace
Dim secondinboxfolder As Outlook.Folder

'initialize outlook application and namespace
Set olapp = New Outlook.Application
Set olnamespace = olapp.GetNamespace("MAPI")

'specify the folder containing the emails in the second inbox
Set secondinboxfolder = olnamespace.Folders("My Name").Folders("Inbox")

'get the items collection for the second inbox folder
Set secondinboxitems = secondinboxfolder.Items

End Sub

Private Sub secondinboxitems_ItemAdd(ByVal Item As Object)
'code to process the items

Dim olapp As Outlook.Application
Dim olnamespace As Outlook.NameSpace
Dim keyword As String

'set the keywords to search for.

keyword = "Keyword"

'check if the received item is a mail item

If TypeOf Item Is Outlook.MailItem Then
'read email body as plain text
Dim body As String
body = Item.body

'check if keyword is present
If InStr(1, body, keyword, vbTextCompare) > 0 Then

'Dim itemtomove As Outlook.MailItem
'Set itemtomove = Item

Item.Move olnamespace.Folders("My Name").Folders("Inbox").Folders("Subfolder")

End If
End If

End Sub

I tried assigning the item as a mail item more specifically. And, I tried re-setting GetNamespace("MAPI").

It seems to be reading the emails for the keyword based on a debug.print of the text compare.


Solution

  • Re: Your comment

    tried;

    Set targetFolder = olapp.Session.GetDefaultFolder(olFolderInbox)
    Item.Move targetFolder
    

    Which, once again has the error.


    olapp does not exist in Private Sub secondinboxitems_ItemAdd(ByVal Item As Object).

    Try this cleaned up code to decrease the confusion.

    Private WithEvents secondinboxitems As Items
    
    'You could instead repeat the
    ' Set secondInboxFolder = Session.Folders("My Name").Folders("Inbox")
    'in
    ' Private Sub secondInboxItems_ItemAdd(ByVal Item As Object)
    Dim secondInboxFolder As Folder    
    
    Sub initializeSecondInboxItems()
    
    'specify the folder containing the emails in the second inbox
    Set secondInboxFolder = Session.Folders("My Name").Folders("Inbox")
    
    'get the items collection for the second inbox folder
    Set secondInboxItems = secondInboxFolder.Items
    
    End Sub
    
    
    Private Sub secondInboxItems_ItemAdd(ByVal Item As Object)
    
    'code to process the items
    Dim destFolder As Folder
    Dim keyword As String
    
    'set the keywords to search for.
    keyword = "Keyword"
    
    'check if the received item is a mail item
    If TypeOf Item Is MailItem Then
    
        'read email body as plain text
        Dim body As String
        body = Item.body
        
        'check if keyword is present
        If InStr(1, body, keyword, vbTextCompare) > 0 Then
            ' secondInboxFolder is declared at the module level
            Set destFolder = secondInboxFolder.Folders("Subfolder")
            Item.Move destFolder
        End If
    End If
    
    End Sub