how can I get name of current outlook IMAP or POP account with VBA during normal send/receive?

Question

I have Outlook 365. I have multiple POP and IMAP accounts. During Send/Receive, I have a rule-script that needs to know which of the accounts is currently being used for the incoming mail. (I want to process each incoming mailitem using the folders for the account that the email was sent to.) For example, if Outlook is currently receiving email into account X, then I want my script to conditionally move that email to "X.Junk E-mail". If Outlook is reading into Y, then the move should be to "Y.Junk E-mail". So I need to get the actual character-string name for the X object, so I can use the correct chain of folders in X to get the "Junk E-mail" folder object. Using "Set junkFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderJunk)" gets the folder for the first account in my collection, NOT the current account.

Answer 1

The Stores property of the Namespace class returns a Stores collection object that represents all the Store objects in the current profile. The Store.GetDefaultFolder method returns a Folder object that represents the default folder in the store and that is of the type specified by the FolderType argument. So the code should look like the following:

Set junkFolder = Application.GetNamespace("MAPI").Stores.Item(1).GetDefaultFolder(olFolderJunk)

To handle the incoming email you need to handle the NewMailEx event of the Application class which is fired once for every received item that is processed by Microsoft Outlook. The item can be one of several different item types, for example, MailItem, MeetingItem, or SharingItem. The EntryIDsCollection string contains the Entry ID that corresponds to that item. Here is what MSDN states:

The NewMailEx event fires when a new message arrives in the Inbox and before client rule processing occurs. You can use the Entry ID returned in the EntryIDCollection array to call the NameSpace.GetItemFromID method and process the item. Use this method with caution to minimize the impact on Outlook performance. However, depending on the setup on the client computer, after a new message arrives in the Inbox, processes like spam filtering and client rules that move the new message from the Inbox to another folder can occur asynchronously. You should not assume that after these events fire, you will always get a one-item increase in the number of items in the Inbox.

Also you may consider handling the ItemAdd event of the Inbox folder. But it may not fire if you receive multiple items at once (more than sixteen). This is a known issue in Outlook.

So, you may check the To recipient and move items to the appropriate store/folder which corresponds to the recipient's email. The Move method of the Outlook items can help.

Answer 2

Here's what worked for me. Notice that there is no looping through the accounts.

Sub deletebysubj(thisitem As Outlook.MailItem)
  Dim objApp As Outlook.Application
  Set objApp = Application
  Dim junkFolder As Outlook.Folder
   Dim myItemSubj
   Dim incoming_item_ID_str  As String
   Dim current_mail_Obj As Outlook.MailItem
   Dim myItem As Object
  Dim thisone As Outlook.Recipient
  Dim theaccount As String
  Dim opa As Outlook.PropertyAccessor

Const PR_SMTP_ADDRESS As String = _
        "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

'get the item ID as a string
   incoming_item_ID_str = thisitem.EntryID
   'now get the item as an object
   Set current_mail_Obj = Application.Session.GetItemFromID(incoming_item_ID_str)
   myItemSubj = current_mail_Obj.Subject
  
  Set receivers = current_mail_Obj.Recipients
'get name of primary receiver
  Set thisone = receivers(1)
  Set opa = thisone.PropertyAccessor     'get that userid's properties
  ' Now get the character-string name of the account being used for the current mail item
  theaccount = opa.GetProperty(PR_SMTP_ADDRESS)
'  We can now get to the "proper" junk email folder for it
    Set junkFolder = Application.GetNamespace("MAPI").Folders(opa.GetProperty(PR_SMTP_ADDRESS)).Folders("Junk E-mail")

If myItemSubj = "junkwords" Then   ' substitute your own words
        current_mail_Obj.Move junkFolder
        MsgBox "item moved to junk folder"
    End If
End Sub

Answer 3

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant

Private Sub test()
    Dim currItem As Object
    Set currItem = ActiveExplorer.Selection(1)
    moveItemToAssociatedJunkFolder currItem
End Sub


Private Sub moveItemToAssociatedJunkFolder(thisItem As Object)

    Dim mailboxFolder As Folder
    Dim thisItemFolder As Folder
    Dim parentTemp As Folder
    
    Dim junkFolder As Folder
    
    If thisItem.Class = olMail Then
    
        Debug.Print "thisItem.Subject: " & thisItem.Subject
        
        If thisItem.Subject = "junkwords" Then   ' substitute your own words
        
            Set thisItemFolder = thisItem.Parent
            Debug.Print "thisItemFolder: " & thisItemFolder
    
StepUp:
            
            On Error Resume Next
            ' Mailbox or subfolder of Mailbox
            Set parentTemp = thisItemFolder.Parent
            On Error GoTo 0
                     
            If Not parentTemp Is Nothing Then
                     
                Debug.Print "parentTemp : " & parentTemp
                     
                Set thisItemFolder = parentTemp
                Debug.Print "thisItemFolder: " & thisItemFolder
                     
                ' Tricky aspect of On Error Resume Next and If Not parentTemp Is Nothing
                Set parentTemp = Nothing
                     
                'Better coders may provide an alternative without GoTo
                GoTo StepUp
             
            Else
         
                 Debug.Print "Nothing found above."
                         
            End If
         
            Set mailboxFolder = thisItemFolder
            Debug.Print "mailboxFolder: " & mailboxFolder
            
            On Error Resume Next
            ' List of all possible junk folder names
            Set junkFolder = mailboxFolder.folders("Junk Email")
            Set junkFolder = mailboxFolder.folders("Junk")
            On Error GoTo 0
            
            thisItem.Move junkFolder
            MsgBox "item moved to junk folder"
         
        End If
        
    End If
   
End Sub

A longer think indicates this idea is not appropriate with a rule as the item is not yet in a folder.
In ItemAdd it would likely be feasible.

Answer 4

Loop through all accounts in the Namespace.Accounts collection and for each account use Account.DeliveryStore to figure out where the particular account is delivering. From there, you can use Store.GetDefaultFolder(olFolderInbox) to figure out the default Inbox.

Note that the number of accounts and stores does not need to match - you can have an account with multiple stores (e.g. Exchange with primary, Public Folders, and delegate stores) or you can have multiple accounts delivering to the same store (e.g. multiple POP3/SMTP accounts delivering to the same PST or Exchange account. Also note that some stores (e.g. Public Folder or a secondary PST) does not necessarily expose an Inbox folder and Store.GetDefaultFolder(olFolderInbox) will fail - you need to catch the exception.

Note that, in theory, POP3/SMTP account does not have to delivered to the default Inbox folder in a particular store - it can be configured to deliver to some other folder in any store. In that case, you can either use Extended MAPI (C++ or Delphi) or Redemption (I am its author - any language) to read the PROP_ACCT_DELIVERY_FOLDER from the corresponding IOlkAccount object (you can see it in OutlookSpy (I am also its author) - click IOlkAccountManager button on the OutlookSpy ribbon). Redemption exposes that setting through the RDOPOP3Account.DeliverToFolder property (RDOPOP3Account can be retrieved either from the RDOSession.Accounts collection or though RDOSession.GetRDOObjectFromOutlookObject if you pass the Outlook.Account object as a parameter).