title: How to choose which Outlook Account a Mailitem is sent from - reliably using SendUsingAccount
body: <p>Let's say you have several accounts attached to your Outlook client and want to be able to choose which one to send a mail from using VBA.  What do you do?  The MailItem.SendUsingAccount parameter looks the right way to do this and is recommended elsewhere <a href="https://stackoverflow.com/questions/17977035/ms-access-outlook-2010-how-to-choose-which-account-to-send-email-from">like here</a> or <a href="http://www.slipstick.com/developer/send-using-default-or-specific-account/" rel="nofollow noreferrer">here</a> or <a href="http://www.rondebruin.nl/win/s1/outlook/account.htm" rel="nofollow noreferrer">here</a>.  However, if you apply the example in the <a href="https://msdn.microsoft.com/en-us/library/office/ff869635.aspx" rel="nofollow noreferrer">Developer Reference</a>, setting the SendUsingAccount property to valid Accounts may be impossible.  Why?   </p>
  
  <p><strong>This appears to be the answer</strong>:  You must Dim your MailItem as an Object and <strong>not</strong> as an Outlook.Mailitem.  It appears that Outlook clients which have one or more Exchange Accounts do not reliably assign Accounts to a MailItem.  But, for some strange reason, if Dim As Object is used instead, the Account can be attached to that Object.  Though that Object has the Properties of a MailItem, it behaves <strong><i>better??? ... strange...</strong></i> </p>
  
  <p>Note:  Sending a mail on <i>on behalf of someone else</i> meets a slightly different requirement.</p>
  
  <p>The following code demonstrates the <strong>problem</strong> and the <strong>solution in operation</strong>.  If there is another solution or I am missing something please let me know.  </p>
  
  <p>After running  the code and noting the Msgbox information, look in the Immediate Window for a summary of what is done.  The printed summary is clearer than the code which has lots of Debug.Print statements. There are 3 routines. The main test routine and 2 which get Account details from your system.</p>
  
  <p>(Now posted as a <a href="https://stackoverflow.com/questions/37785761/send-mail-with-specific-mailbox-defaults-from-outlook-with-pop3-or-exchange">separate question</a> at <a href="https://stackoverflow.com/users/4713729/vacip">vacip</a>'s suggestion) 
  When MailItems are created they have the characteristics of the default Account, such as signatures etc. which may need changing.  If anyone knows a good way to create the initial MailItem with the characteristics of a chosen Account instead, avoiding a lot of copy/pastes/Assignments, please let me know.  </p>
  
  <pre><code>Private Sub TestSendingAccountProblems()
  'This test demonstrates the problems that occur when trying to set
  ' the SendingAccount of a MailItem in Outlook.
  'In summary, it appears that when an Outlook client has an Exchange account attached,
  ' it is only possible to set the SendingAccount of a MailItem if
  ' THE MailItem IS CREATED AS AN OBJECT.
  ' A bare MailItem fails with an ERROR.
  'The MailItem's SendingAccount can be set to Pop3 or Exchange, so long as the MailItem is an Object.
  'It does not seem to matter whether a Pop3 or an Exchange Mailbox is active at the time.
  ' Choosing different mailboxes causes different signatures to be appended,(if set) but
  ' does not affect this SendingAccount behaviour.
  'The behaviour probably is different if no Exchange account is attached - try it on your
  ' Outlook client if you have such a system.  Look at the listings in the Immediate Window &amp;
  ' let us all know what you discover. (Cntrl-G in the VBIDE for the Immediate Window)
  
  'All the Print statements make this and the routines it calls rather hard to read.
  'You can start by just running it!
  
  Dim appOl As Outlook.Application
  Dim objNameSpace As Outlook.NameSpace
  Dim olMailItem As Outlook.MailItem
  Dim objOutlookMsg As Object
  Dim SendingAccount As Outlook.Account
  Dim sOlPOP3Account As String
  Dim sOlExchangeAccount As String
  Dim arr() As String
  Dim i As Long
  Dim NumAccts As Long
  Dim S As String
  
      Debug.Print String(100, "=")
      Set appOl = Outlook.Application
      Set objNameSpace = appOl.GetNamespace("MAPI")
  
  'Notice that the Creation statements here are identical, this creates an Object to contain the MailItem
      Set objOutlookMsg = appOl.CreateItem(olItemType.olMailItem) 'This creates an Object to contain the MailItem
         Set olMailItem = appOl.CreateItem(olItemType.olMailItem) 'This creates a straightforward Mailitem.
  'The line above creates a MailItem.
  'The only difference is that olMailItem is explicitly Dimensioned as an Outlook.MailItem.
  
      'Write out the status
      S = objOutlookMsg.UserProperties.Session.CurrentUser.AddressEntry.Address
      Debug.Print "objOutlookMsg was created by a user with this Address: " &amp; S
      S = olMailItem.UserProperties.Session.CurrentUser.AddressEntry.Address
      Debug.Print "olMailItem was created by a user with this Address:    " &amp; S
      If objOutlookMsg.SendUsingAccount Is Nothing Then
          Debug.Print "objOutlookMsg.SendUsingAccount has no account specified on creation "
      Else
          Debug.Print "objOutlookMsg.SendUsingAccount.DisplayName = " &amp; objOutlookMsg.SendUsingAccount.DisplayName
      End If
      If olMailItem.SendUsingAccount Is Nothing Then
          Debug.Print "olMailItem.SendUsingAccount    has no account specified on creation "
      Else
          Debug.Print "olMailItem.SendUsingAccount.DisplayName    =  " &amp; olMailItem.SendUsingAccount.DisplayName
      End If
  
      'Collect the Account DisplayNames
  'The strings here must be the Account Name.  To see these, do this:
  'Outlook Ribbon: File&gt;Account Settings&gt;AccountSettings-Name column.
  ' You can enter your own accounts here, but it is easier to let it fetch them all for you using the code below.
  '    sOlPOP3Account = "my.name@POP3server.com"
  '    sOlExchangeAccount = "my.name@ExchangeServer.com"
  'ReDim arr(1 To 2)
  '    NumAccts = 2
  '    arr(1) = sOlPOP3Account
  '    arr(2) = sOlExchangeAccount
  '
      'Automatically includes up to 10 accounts
      NumAccts = 0
      For i = 1 To 10
  '   Choose all accounts or just one of these: (don't leave both exposed)
          S = GetAccountNameOfType(vbNullString)      'This will get all accounts that are accessible from the Outlook client'
  '        S = GetAccountNameOfType("POP3")            'This will get only the Pop3 accounts that are accessible from the Outlook client
          If S = vbNullString Then Exit For
          NumAccts = NumAccts + 1
  ReDim Preserve arr(1 To NumAccts)
          arr(NumAccts) = S
      Next i
  
      For i = 1 To NumAccts
          S = GetAccountType(arr(i), i)
          On Error Resume Next
          Set SendingAccount = appOl.Session.Accounts.Item(arr(i))
          If ERR &lt;&gt; 0 Or SendingAccount Is Nothing Then
              Debug.Print String(20, "-") &amp; vbLf &amp; S &amp; " account could NOT be set to variable SendingAccount. The " &amp; S &amp; " account has .DisplayName = " &amp; arr(i)
          Else
              Debug.Print String(20, "+") &amp; vbLf &amp; S &amp; " account WAS          set to variable SendingAccount. The " &amp; S &amp; " account has .DisplayName = " &amp; arr(i)
          End If
          'Works fine in all scenarios tested using an Outlook client with an Exchange account attached.
        Object   ' The Watch Window shows .SendingAccount = chosen Account of Type = Account/Account
          On Error Resume Next
          Set objOutlookMsg.SendUsingAccount = SendingAccount
          If ERR &lt;&gt; 0 Then
              Debug.Print "objOutlookMsg.SendUsingAccount was NOT SET.  The Error number is " &amp; ERR &amp; ", Description: " &amp; ERR.Description &amp; " - look at what was printed above for status of the SendingAccount (or look above/check in the Watch window if stepping through.)"
          Else
              Debug.Print "objOutlookMsg.SendUsingAccount was set successfully to: " &amp; objOutlookMsg.SendUsingAccount.DisplayName
          End If
          On Error Resume Next
          'Fails .in all scenarios tested using an Outlook client with an Exchange account attached.
          ' The Watch Window shows .SendingAccount = chosen Account of Type = Account/Account
          Set olMailItem.SendUsingAccount = SendingAccount
          If ERR &lt;&gt; 0 Then
              Debug.Print "   olMailItem.SendUsingAccount was NOT SET.  The Error number is " &amp; ERR &amp; ", Description: " &amp; ERR.Description &amp; " (the SendingAccount may be 'Nothing' - look above/check in the Watch window.)"
          Else
              Debug.Print "   olMailItem.SendUsingAccount was set successfully to: " &amp; olMailItem.SendUsingAccount.DisplayName
          End If
      Next i
  
  
  'Clean up
  Set appOl = Nothing
  Set objNameSpace = Nothing
  Set olMailItem = Nothing
  Set objOutlookMsg = Nothing
  Set SendingAccount = Nothing
  End Sub'Started with code from:
  'https://social.msdn.microsoft.com/Forums/en-US/7a8bed41-a28f-41aa-bbc5-bfb8057a7bc4/stuck-on-how-to-get-sendusingaccount-to-work?forum=isvvba
  'revised to create 2 functions that return the current account's status and displays all the accounts at one time, neatly lined up
  'and another that finds accounts of a specified type.
  Private Function GetAccountType(sForDisplayName As String, _
                                  Optional lDisplayMessage As Long) As String
  ' Returns the type of the account named sForDisplayName.
  ' Shows a message listing all the accounts and types only if lDisplayMessage is = +1 or -1.
      'NOTE: If changes to the email accounts have been made in Outlook _
       then must close Outlook and Re-Open before any of this works properly.
  
  Dim objOutlook As Object
  Dim objNameSpace As Object
  Dim strAccountType As String
  Dim strOlNameAccountType As String
  Dim Account As Outlook.Account
  Dim i As Long
  Dim HitNum As Long
  Dim bAcc As Boolean         'Determines whether the Account Type or the Account name of the next Account of Given Type is returned
  Dim S As String             'Scratch string
  Dim S1 As String            'Scratch string
  Static LenStr As Long       'The Length of the display string in the MsgBox window
  Static lGT As Long          'Account number within NumAccts that we have reached
  Static sLstAcType As String 'The last Account type that was specified in sGetNextAccountOfType
  Static NumAccts As Long     'The number of Accounts
  
      Set objOutlook = CreateObject("Outlook.Application")
      Set objNameSpace = objOutlook.GetNamespace("MAPI")
      LenStr = 40
  
  DO_AGAIN:                                            'Returns to here if the account names are found to be long
      S = vbNullString
  
      For i = 1 To objNameSpace.Session.Accounts.Count
          Set Account = objNameSpace.Session.Accounts.Item(i)
          If Len(Account.DisplayName) + 10 + 1 &gt; LenStr Then
              LenStr = Len(Account.DisplayName) + 10 + 1
              If LenStr &gt; 86 Then LenStr = 86: GoTo GET_ON_WITH_IT
              GoTo DO_AGAIN
          End If
  GET_ON_WITH_IT:
          With Account
              S1 = Right(String(LenStr - 10, "-") &amp; Account.DisplayName, LenStr - 10)
              Select Case .AccountType
              Case 0
                 strAccountType = "Exchange"
                  strOlNameAccountType = Right(String(10, "-") &amp; "olExchange", 10)    'Watch Window shows olExchange
              Case 2
                  strAccountType = "POP3"
                  strOlNameAccountType = Right(String(10, "-") &amp; "olPop3", 10)        'Watch Window shows olExchange
              Case Else
                  strAccountType = "Not POP3 or Exchange Account"
                  strOlNameAccountType = Right(String(10, "-") &amp; "Not P3/Exg", 10)    'Don't know what Watch Window shows!
              End Select
              S = S &amp; i &amp; "-" &amp; Right(String(LenStr + 1, "-") &amp; S1 &amp; vbTab &amp; "-" &amp; strOlNameAccountType, LenStr + 1) &amp; vbLf
              If Abs(lDisplayMessage) = 1 Then _
                  Debug.Print Replace(i &amp; "-" &amp; Right(String(LenStr + 1, "-") &amp; S1 &amp; vbTab &amp; "-" &amp; strOlNameAccountType, LenStr + 1), "-", " ")
              If .DisplayName = sForDisplayName Then
                  GetAccountType = strAccountType
              End If
          End With
      Next i
      NumAccts = i - 1
      'Only displays when lDisplayMessage = +1 or -1.  Defaults to not displaying if lDisplayMessage is is unset.
      If Abs(lDisplayMessage) = 1 Then _
      MsgBox String(86, "-") &amp; vbLf &amp; "List of all Email Accounts on " &amp; Environ$("computername") &amp; ":" &amp; vbLf &amp; _
             Left("- Account " &amp; String(LenStr - Len("- Account " &amp; vbTab &amp; "Type"), "-"), LenStr) &amp; vbTab &amp; "Type" &amp; vbLf &amp; _
             S &amp; vbLf &amp; _
             String(86, "-")
  
      Set objNameSpace = Nothing
      Set objOutlook = Nothing
      Set Account = Nothing
  
  End Function
  
  Private Function GetAccountNameOfType(sTypeToGet As String) As String
  ' Gets the next account of the given type.
  ' Called repeatedly with the same sTypeToGet returns a Null string on the last found (or if none are).
  ' If the VBIDE is reset, it starts again at the beginning.
      'NOTE: If changes to the email accounts have been made in Outlook _
       then must close Outlook and Re-Open before any of this works properly.
  
  Dim objOutlook As Object
  Dim objNameSpace As Object
  Dim strAccountType As String
  Dim Account As Outlook.Account
  Dim i As Long
  Dim HitNum As Long
  Dim bInit As Boolean        'It is an initialisation run
  Static lGT As Long          'Account number within NumAccts that we have reached
  Static sLstAcType As String 'The last Account type that was specified in sTypeToGet
  Static NumAccts As Long     'The number of Accounts
  
      If NumAccts &gt; 0 Then
          lGT = lGT + 1                   'Get the next hit
      Else
          bInit = True                    'Be sure to count the accounts on the first run
          lGT = 1                         'and when the last exit resulted in no hit
      End If
  
      Set objOutlook = CreateObject("Outlook.Application")
      Set objNameSpace = objOutlook.GetNamespace("MAPI")
  
      For i = 1 To objNameSpace.Session.Accounts.Count
          Set Account = objNameSpace.Session.Accounts.Item(i)
          With Account
              Select Case .AccountType
              Case 0
                 strAccountType = "Exchange"
              Case 2
                  strAccountType = "POP3"
              Case Else
                  strAccountType = "Not POP3 or Exchange Account"
              End Select
              If UCase(strAccountType) = UCase(sTypeToGet) Or sTypeToGet = vbNullString Then
                  HitNum = HitNum + 1
                  If HitNum = lGT Then
                      GetAccountNameOfType = Account.DisplayName
                      If Not bInit Then
                          If sTypeToGet &lt;&gt; vbNullString Then NumAccts = HitNum
                          GoTo FOUNDIT
                      End If
                  End If
              End If
          End With
      Next i
      If Not bInit Then
          If GetAccountNameOfType = vbNullString Then
              NumAccts = 0
          Else
              NumAccts = i - 1
          End If
      Else
          NumAccts = i - 1        'Always keep a count when initialising
      End If
  FOUNDIT:
      sLstAcType = sTypeToGet
  
      Set objNameSpace = Nothing
      Set objOutlook = Nothing
      Set Account = Nothing
  
  End Function
  
  
  
  'https://social.msdn.microsoft.com/Forums/en-US/7a8bed41-a28f-41aa-bbc5-bfb8057a7bc4/stuck-on-how-to-get-sendusingaccount-to-work?forum=isvvba
      'was heavily adapted to create 2 functions that return the current account's status and displays all the accounts at one time, neatly lined up
      'and another that finds accounts of a specified type.
      Private Function GetAccountType(sForDisplayName As String, _
                                      Optional lDisplayMessage As Long) As String
      ' Returns the type of the account named sForDisplayName.
      ' Shows a message listing all the accounts and types only if lDisplayMessage is = +1 or -1.
          'NOTE: If changes to the email accounts have been made in Outlook _
           then must close Outlook and Re-Open before any of this works properly.
  
  Dim objOutlook As Object
  Dim objNameSpace As Object
  Dim strAccountType As String
  Dim strOlNameAccountType As String
  Dim Account As Outlook.Account
  Dim i As Long
  Dim HitNum As Long
  Dim bAcc As Boolean         'Determines whether the Account Type or the Account name of the next Account of Given Type is returned
  Dim S As String             'Scratch string
  Dim S1 As String            'Scratch string
  Static LenStr As Long       'The Length of the display string in the MsgBox window
  Static lGT As Long          'Account number within NumAccts that we have reached
  Static sLstAcType As String 'The last Account type that was specified in sGetNextAccountOfType
  Static NumAccts As Long     'The number of Accounts
  
      Set objOutlook = CreateObject("Outlook.Application")
      Set objNameSpace = objOutlook.GetNamespace("MAPI")
      LenStr = 40
  
  DO_AGAIN:                                            'Returns to here if the account names are found to be long
      S = vbNullString
  
      For i = 1 To objNameSpace.Session.Accounts.Count
          Set Account = objNameSpace.Session.Accounts.Item(i)
          If Len(Account.DisplayName) + 10 + 1 &gt; LenStr Then
              LenStr = Len(Account.DisplayName) + 10 + 1
              If LenStr &gt; 86 Then LenStr = 86: GoTo GET_ON_WITH_IT
              GoTo DO_AGAIN
          End If
  GET_ON_WITH_IT:
          With Account
              S1 = Right(String(LenStr - 10, "-") &amp; Account.DisplayName, LenStr - 10)
              Select Case .AccountType
              Case 0
                 strAccountType = "Exchange"
                  strOlNameAccountType = Right(String(10, "-") &amp; "olExchange", 10)    'Watch Window shows olExchange
              Case 2
                  strAccountType = "POP3"
                  strOlNameAccountType = Right(String(10, "-") &amp; "olPop3", 10)        'Watch Window shows olExchange
              Case Else
                  strAccountType = "Not POP3 or Exchange Account"
                  strOlNameAccountType = Right(String(10, "-") &amp; "Not P3/Exg", 10)    'Don't know what Watch Window shows!
              End Select
              S = S &amp; i &amp; "-" &amp; Right(String(LenStr + 1, "-") &amp; S1 &amp; vbTab &amp; "-" &amp; strOlNameAccountType, LenStr + 1) &amp; vbLf
              If Abs(lDisplayMessage) = 1 Then _
                  Debug.Print Replace(i &amp; "-" &amp; Right(String(LenStr + 1, "-") &amp; S1 &amp; vbTab &amp; "-" &amp; strOlNameAccountType, LenStr + 1), "-", " ")
              If .DisplayName = sForDisplayName Then
                  GetAccountType = strAccountType
              End If
          End With
      Next i
      NumAccts = i - 1
      'Only displays when lDisplayMessage = +1 or -1.  Defaults to not displaying if lDisplayMessage is is unset.
      If Abs(lDisplayMessage) = 1 Then _
      MsgBox String(86, "-") &amp; vbLf &amp; "List of all Email Accounts on " &amp; Environ$("computername") &amp; ":" &amp; vbLf &amp; _
             Left("- Account " &amp; String(LenStr - Len("- Account " &amp; vbTab &amp; "Type"), "-"), LenStr) &amp; vbTab &amp; "Type" &amp; vbLf &amp; _
             S &amp; vbLf &amp; _
             String(86, "-")
  
      Set objNameSpace = Nothing
      Set objOutlook = Nothing
      Set Account = Nothing
  
  End Function
  
  Private Function GetAccountNameOfType(sTypeToGet As String) As String
  ' Gets the next account of the given type.
  ' Called repeatedly with the same sTypeToGet returns a Null string on the last found (or if none are).
  ' If the VBIDE is reset, it starts again at the beginning.
      'NOTE: If changes to the email accounts have been made in Outlook _
       then must close Outlook and Re-Open before any of this works properly.
  
  Dim objOutlook As Object
  Dim objNameSpace As Object
  Dim strAccountType As String
  Dim Account As Outlook.Account
  Dim i As Long
  Dim HitNum As Long
  Dim bInit As Boolean        'It is an initialisation run
  Static lGT As Long          'Account number within NumAccts that we have reached
  Static sLstAcType As String 'The last Account type that was specified in sTypeToGet
  Static NumAccts As Long     'The number of Accounts
  
      If NumAccts &gt; 0 Then
          lGT = lGT + 1                   'Get the next hit
      Else
          bInit = True                    'Be sure to count the accounts on the first run
          lGT = 1                         'and when the last exit resulted in no hit
      End If
  
      Set objOutlook = CreateObject("Outlook.Application")
      Set objNameSpace = objOutlook.GetNamespace("MAPI")
  
      For i = 1 To objNameSpace.Session.Accounts.Count
          Set Account = objNameSpace.Session.Accounts.Item(i)
          With Account
              Select Case .AccountType
              Case 0
                 strAccountType = "Exchange"
              Case 2
                  strAccountType = "POP3"
              Case Else
                  strAccountType = "Not POP3 or Exchange Account"
              End Select
              If UCase(strAccountType) = UCase(sTypeToGet) Or sTypeToGet = vbNullString Then
                  HitNum = HitNum + 1
                  If HitNum = lGT Then
                      GetAccountNameOfType = Account.DisplayName
                      If Not bInit Then
                          If sTypeToGet &lt;&gt; vbNullString Then NumAccts = HitNum
                          GoTo FOUNDIT
                      End If
                  End If
              End If
          End With
      Next i
      If Not bInit Then
          If GetAccountNameOfType = vbNullString Then
              NumAccts = 0
          Else
              NumAccts = i - 1
          End If
      Else
          NumAccts = i - 1        'Always keep a count when initialising
      End If
  FOUNDIT:
      sLstAcType = sTypeToGet
  
      Set objNameSpace = Nothing
      Set objOutlook = Nothing
      Set Account = Nothing
  
  End Function
  </code></pre>
  
  <p>Here is a sample of the output from running this program on an Outlook Client that has 2 POP3 and 1 Exchange account attached to it:</p>
  
  <pre><code>    ''====================================================================================================
  ''objOutlookMsg was created by a user with this Address: /o=ExchangeLabs/ou=Exchange Administrative Group (lotsofcharacter)/cn=Recipients/cn=longhexnumberisplacedherefollowe-dname
  ''olMailItem was created by a user with this Address:    /o=ExchangeLabs/ou=Exchange Administrative Group (lotsofcharacter)/cn=Recipients/cn=longhexnumberisplacedherefollowe-dname
  ''objOutlookMsg.SendUsingAccount has no account specified on creation 
  ''olMailItem.SendUsingAccount    has no account specified on creation 
  ''olMailItem.SendUsingAccount    has no account specified on creation
  ''1     joey.bloggs@POP3server.com         olPop3
  ''2 jane.blogginnss@POP3server.com         olPop3
  ''3           X@exchangeserver.com     olExchange
  ''++++++++++++++++++++
  ''POP3 account WAS          set to variable SendingAccount. The POP3 account has .DisplayName = joey.bloggs@POP3server.com
  ''objOutlookMsg.SendUsingAccount was set successfully to: joey.bloggs@POP3server.com
  ''   olMailItem.SendUsingAccount was NOT SET.  The Error number is 91, Description: Object variable or With block variable not set (the SendingAccount may be 'Nothing' - look above/check in the Watch window.)
  ''++++++++++++++++++++
  ''POP3 account WAS          set to variable SendingAccount. The POP3 account has .DisplayName = jane.blogginnss@POP3server.com
  ''objOutlookMsg.SendUsingAccount was set successfully to: jane.blogginnss@POP3server.com
  ''   olMailItem.SendUsingAccount was NOT SET.  The Error number is 91, Description: Object variable or With block variable not set (the SendingAccount may be 'Nothing' - look above/check in the Watch window.)
  ''++++++++++++++++++++
  ''Exchange account WAS          set to variable SendingAccount. The Exchange account has .DisplayName = X@exchangeserver.com
  ''objOutlookMsg.SendUsingAccount was set successfully to: X@exchangeserver.com
  ''   olMailItem.SendUsingAccount was NOT SET.  The Error number is 91, Description: Object variable or With block variable not set (the SendingAccount may be 'Nothing' - look above/check in the Watch window.)
  </code></pre>