Search code examples
vbaoutlook

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


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 [email protected] (used by multiple people).

How do I address the Accounting inbox?


Solution

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