Change FROM email account in Email Message by VBA Outlook 2016

[rivergum_23]

Hi All,

When using outlook with multiple email accounts, is it possible to change which email account (the non default account) the emails are sent from automatically via VBA code when a new message is composed.

I understand that by changing the default account this would allow the "From" account to be what I need, however I am required to keep the default account as is because other 3rd party programs send the default account which can't be changed. New composed emails sent from Outlook however I would like send from the 2nd account without user intervention (automatic).

Untitled.jpg

Obviously this can be changed manually by a couple of clicks of a mouse, however I'm hoping this is possible to do automatically when a new message window is opened in outlook.

Any help would be very much appreciated.

Thanks in Advance

River

[skatonni]

Send manually to see if you have the required permissions, then change .Display to .Send

Option Explicit

Private Sub Mail_From__Account_DisplayName()

    ' To verify there are additional accounts
    '  not additional mailboxes in the default account

    Dim OutMail As MailItem
    Dim i As Long
    Dim AcctCount As Long
    
    Dim accDispName As String
    
    AcctCount = Session.Accounts.count
    Debug.Print AcctCount
    
    If AcctCount > 1 Then
    
        For i = 1 To AcctCount
    
        Set OutMail = CreateItem(olMailItem)
    
        With OutMail
            
            Debug.Print "  Account # " & i & ": " & Session.Accounts.item(i)
             
            accDispName = Session.Accounts(i).DisplayName
            .SendUsingAccount = Session.Accounts(accDispName)
            
            .Display
            
        End With
        
        Next
        
    Else
    
        Debug.Print "You have one account only."
    
    End If
End Sub

Private Sub SendUsingAccount_Other()

    Dim objMsg As MailItem
    Dim accDispName As String
    
    Set objMsg = CreateItem(olMailItem)
    
    accDispName = "accDispNameString"
    objMsg.SendUsingAccount = Session.Accounts(accDispName)
    
    objMsg.Display
End Sub

Alternative to SendUsingAccount is SentOnBehalfOfName

 Private Sub SentOnBehalf()

    ' With either an additional mailbox in the default account
    '  or where there are multiple accounts
    
    Dim objMsg As MailItem
    
    Set objMsg = CreateItem(olMailItem)
    objMsg.SentOnBehalfOfName = "AddressofOtherMailbox"
    objMsg.Display
End Sub