SendUsingAccount SendAs permissions but not finding in index - vba

Question

I need to be able to send an email from VBA from a different email address. I have permissions to send from that address and can select it manually from the Outlook Message window. However, there is no index to it when I run the following code. All that shows up is my email address.
Sub Which_Account_Number()
'Don't forget to set a reference to Outlook in the VBA editor
Dim OutApp As Object
Dim I As Long
Set OutApp = CreateObject("Outlook.Application")
For I = 1 To OutApp.Session.Accounts.Count
MsgBox OutApp.Session.Accounts.Item(I) & " : This is account number " & I
Next I
End Sub
Is there a way to use the actual email address in the call? This is my test code for what I am trying to accomplish:
Sub SendMessagesTest()
Dim objOutlook As Object ' Outlook.Application
Dim objOutlookMsg As Object ' Outlook.MailItem
Dim objOutlookRecip As Object ' Outlook.Recipient
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
objOutlook.Session.Logon
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(0) '0 = olMailItem
With objOutlookMsg
' Set the Subject & Body of the message.
.Subject = "Test Subject"
.Body = "Test Body"
'.BodyFormat = 3 '3 = olFormatRichText (Late Binding)
'Change Item(1)to another number to use another account
Set .SendUsingAccount = "TestUser#test.com" 'objOutlook.Session.Accounts.Item(2) ' (Late Binding)
.Display
End With
Set objOutlook = Nothing
Set objOutlookMsg = Nothing
Set objOutlookRecip = Nothing
Exit Sub
End Sub
When I run it I get the error "Object Required".
I cannot use this type of code because I do not have an index number to use for the email address:
Set .SendUsingAccount = objOutlook.Session.Accounts.Item(1)
Edit: This is the code that I use to add an appointment item to another user's calendars which have been shared with me. Note: I have Publishing Editor permissions on the mailbox I am trying to Send As.
Sub CreateCalendarApptx()
Dim objApp As Object
Dim objNS As Object
Dim objFolder As Object
Dim objRecip As Object
Dim objAppt As Object
Dim objMsg As Object
Const olMailItem = 0
Const olFolderCalendar = 9
Dim strName As String
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.getNamespace("MAPI")
Set objMsg = objApp.CreateItem(olMailItem)
strName = "OtherUser#Test.com"
'Select Calendar on which to place the appointment
'The Calendar can either be set with the name of the calendar or the Folder ID
If Left(strName, 3) = "ID:" Then
'Strip out the ID: identifier and leave just the ID
strName = Mid(strName, 5, Len(strName))
Set objFolder = objNS.GetFolderFromID(strName)
Else
Set objRecip = objMsg.Recipients.Add(strName)
objRecip.Resolve
If objRecip.Resolved Then
Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)
End If
End If
Set objAppt = objFolder.Items.Add
objAppt.Subject = "Test"
objAppt.Display
Set objApp = Nothing
Set objNS = Nothing
Set objFolder = Nothing
Set objMsg = Nothing
Set objRecip = Nothing
Set objAppt = Nothing
End Sub
Edit 2:
I added another comment earlier, but the board didn't seem to like it because I attached a picture. The upshot is that when I send an email from the Outlook interface with a different name in the From: field, it sends successfully. However, when I hover over it I see "From: OtherUser#test.com Send Using Account: Me#test.com" If that is the case, the SendUsingAccount in VBA would be my email address, and there should be another property that would be the From: field.

Answer 1

change your statement from:
Set .SendUsingAccount = objOutlook.Session.Accounts.Item(1)
to:
Set .SendUsingAccount = objOutlook.Session.Accounts.Item("Testuser#test.com")

Answer 2

I was able to get SendUsingAccount to work -- except that items sat in the other account's Outbox and never were sent.
I finally got it to work by creating a mail profile that had the account I wanted to send as from as the only account. Then I added my mail account but left the SendUsingAccount as the default account for the profile to use. That way it continued to work.
But that's a bit inconvenient, except in my case the computer running the software is not my primary computer, so having the default profile set to a mail account other than mine will be bearable.

Answer 3

Are you sending on behalf of a delegate Exchange mailbox? Set the MailItem.SentOnBehalfOfName property.

Answer 4

Re: Comment to other answer post. It is unusual to do this "I can set appointments on other people's calendars from VBA".
If you have such rights, to the inbox of the other mailbox, you may be able to do this.
Option Explicit
Sub SendMailFromNonDefaultAccount()
' The only way I know this works is to
' use the "Add Account" button to add a non-default account.
' Not "Account Settings" which adds a mailbox to the default Account.
Dim myRecipient As recipient
Dim nonDefaultInboxFolder As Folder
Dim addMail As MailItem
' This is where your unusual permission, without adding an account, might yet kick in
Set myRecipient = Session.CreateRecipient("non-default email address as a string inside quotes")
Set nonDefaultInboxFolder = Session.GetSharedDefaultFolder(myRecipient, olFolderInbox)
' Add, not create, in non-default folder
Set addMail = nonDefaultInboxFolder.Items.Add
' The non-default email address will be in the "From"
addMail.Display
End Sub
With the code for the shared calendar applied to the shared inbox.
Option Explicit
Sub CreateCalendarAppt_and_mail()
Dim objApp As Object
Dim objNS As Object
Dim objFolder As Object
Dim objRecip As Object
Dim objAppt As Object
Dim objMsg As Object
Dim objInboxShared As Object
Dim objMsgShared As Object
' If there is no reference to the Outlook Object Library
Const olFolderInbox = 6
Const olMailItem = 0
Const olFolderCalendar = 9
Dim strName As String
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objMsg = objApp.CreateItem(olMailItem)
strName = "OtherUser#Test.com"
Debug.Print strName
Set objRecip = objMsg.Recipients.Add(strName)
objRecip.Resolve
If objRecip.Resolved Then
Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)
Set objAppt = objFolder.Items.Add
objAppt.Subject = "Test"
objAppt.Display
' Follows the format of the calendar code
' Looks the same as my original code
Set objInboxShared = objNS.GetSharedDefaultFolder(objRecip, olFolderInbox)
' objInboxShared.Display
Set objMsgShared = objInboxShared.Items.Add
objMsgShared.Subject = "Test Message"
objMsgShared.Display
End If
Set objApp = Nothing
Set objNS = Nothing
Set objFolder = Nothing
Set objMsg = Nothing
Set objRecip = Nothing
Set objAppt = Nothing
Set objInboxShared = Nothing
Set objMsgShared = Nothing
End Sub

Answer 5

I had two machines that were experiencing this same problem.
With the first machine, the user was being prompted to select a profile on opening Outlook. By setting the Control Panel/Mail profile setting so that it "Always use this profile", the problem was fixed.
The second machone had two profiles. Even though the main one was selected to "always use this profile", it still had the same problem. By removing the second profile, the problem went away.