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