How to run code on second inbox (shared account)? - vba

Question

I move an email to a specific subfolder of the inbox as soon as it has been tagged with the tag "Invoice".
Private WithEvents objInboxFolder As Outlook.Folder
Private WithEvents objInboxItems As Outlook.Items
'Process inbox mails
Private Sub Application_Startup()
Set objInboxFolder = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
Set objInboxItems = objInboxFolder.Items
End Sub
'Occurs when changing item
Private Sub objInboxItems_ItemChange(ByVal Item As Object)
Dim objMail As Outlook.MailItem
Dim objTargetFolder As Outlook.Folder
If TypeOf Item Is MailItem Then
Set objMail = Item
'Move mails based on color category
If InStr(objMail.Categories, "Invoice") > 0 Then
Set objTargetFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders("Invoices").Folders("Uploaded")
objMail.Move objTargetFolder
End If
End If
End Sub
I have two mailboxes/accounts in Outlook. My personal email address as well as Accounting#company.com (used by multiple people).
How do I address the Accounting inbox?

Answer 1

You can use the Store.GetDefaultFolder method which returns a Folder object that represents the default folder in the store and that is of the type specified by the FolderType argument. This method is similar to the GetDefaultFolder method of the NameSpace object. The difference is that this method gets the default folder on the delivery store that is associated with the account, whereas NameSpace.GetDefaultFolder returns the default folder on the default store for the current profile.
So, you can enumerate stores in the Outlook profile and find the required one. For example, the following code shows how to iterate over all stores and folders in Outlook recursively:
Sub EnumerateFoldersInStores()
Dim colStores As Outlook.Stores
Dim oStore As Outlook.Store
Dim oRoot As Outlook.Folder
On Error Resume Next
Set colStores = Application.Session.Stores
For Each oStore In colStores
Set oRoot = oStore.GetRootFolder
Debug.Print (oRoot.FolderPath)
EnumerateFolders oRoot
Next
End Sub
Private Sub EnumerateFolders(ByVal oFolder As Outlook.Folder)
Dim folders As Outlook.folders
Dim Folder As Outlook.Folder
Dim foldercount As Integer
On Error Resume Next
Set folders = oFolder.folders
foldercount = folders.Count
'Check if there are any folders below oFolder
If foldercount Then
For Each Folder In folders
Debug.Print (Folder.FolderPath)
EnumerateFolders Folder
Next
End If
End Sub
You can check out the Store.DisplayName property to find the required store in the profile and then get the required inbox folder of the specific store in Outlook.