Possible to override default send account?

[OldRelic115]

I am trying to override the default sending account in code. Very simple example-


Sub Application_ItemSend _
(ByVal Item As Object, Cancel As Boolean)

Item.SendUsingAccount = Application.Session.Accounts("non-defaultacount")

End Sub


I thought that this would override the default account but it doesn't. Is it not possible or am I doing it wrong?

Thanks for any suggestions

[gmayor]

If you change the sending account from the message before clicking send, does it then use that account? If so then the following (in a new ordinary module) will emulate that

Create a userform and name it frmSelectAccount. Add a label, a list box and a pair of command buttons each with their default names.

The macros will set the sizes and position the elements. Then use the macros to create the messages or reply to existing messages.



Sub SendUsingAccount()
'Graham Mayor - http://www.gmayor.com - Last updated - 06 Aug 2017
Dim oAccount As Outlook.Account
Dim strAcc As String
Dim oMail As Outlook.MailItem
Dim i As Long
With frmSelectAccount
.BackColor = RGB(191, 219, 255)
.Height = 190
.Width = 240
.Caption = "Send Mail"
With .CommandButton1
.Caption = "Next"
.Height = 24
.Width = 72
.Top = 126
.Left = 132
End With
With .CommandButton2
.Caption = "Quit"
.Height = 24
.Width = 72
.Top = 126
.Left = 24
End With

With .ListBox1 'add your list of email addresses
.Height = 72
.Width = 180
.Left = 24
.Top = 42
For Each oAccount In Application.Session.Accounts
.AddItem oAccount
Next oAccount
End With
With .Label1
.BackColor = RGB(191, 219, 255)
.Height = 24
.Left = 24
.Width = 174
.Top = 6
.Font.Size = 10
.Caption = "Select e-mail account from which to send this message"
.TextAlign = fmTextAlignCenter
End With
.Show
If .Tag = 0 Then
Unload frmSelectAccount
Exit Sub
End If
With frmSelectAccount.ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
strAcc = .List(i)
Exit For
End If
Next i
End With
End With
Unload frmSelectAccount
For Each oAccount In Application.Session.Accounts
If oAccount.DisplayName = strAcc Then
Set oMail = Application.CreateItem(olMailItem)
With oMail
.SendUsingAccount = oAccount
.Display
.Subject = "The subject"
End With
Exit For
End If
Next
Set oAccount = Nothing
Set oMail = Nothing
lbl_Exit:
Exit Sub
End Sub

Sub ReplyUsingAccount()
'Graham Mayor - http://www.gmayor.com - Last updated - 06 Aug 2017
Dim oAccount As Outlook.Account
Dim objItem As Outlook.MailItem
Dim oMail As Outlook.MailItem
Dim strAcc As String
Dim i As Long
Set objItem = ActiveExplorer.Selection.Item(1)
With frmSelectAccount
.BackColor = RGB(191, 219, 255)
.Height = 190
.Width = 240
.Caption = "Reply to Mail"
With .CommandButton1
.Caption = "Next"
.Height = 24
.Width = 72
.Top = 126
.Left = 132
End With
With .CommandButton2
.Caption = "Quit"
.Height = 24
.Width = 72
.Top = 126
.Left = 24
End With

With .ListBox1 'add your list of email addresses
.Height = 72
.Width = 180
.Left = 24
.Top = 42
For Each oAccount In Application.Session.Accounts
.AddItem oAccount
Next oAccount
End With
With .Label1
.BackColor = RGB(191, 219, 255)
.Height = 24
.Left = 24
.Width = 174
.Top = 6
.Font.Size = 10
.Caption = "Select e-mail account from which to send this reply"
.TextAlign = fmTextAlignCenter
End With
.Show
If .Tag = 0 Then
Unload frmSelectAccount
Exit Sub
End If
With frmSelectAccount.ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
strAcc = .List(i)
Exit For
End If
Next i
End With
End With
Unload frmSelectAccount
For Each oAccount In Application.Session.Accounts
If oAccount.DisplayName = strAcc Then
Set oMail = objItem.Reply
With oMail
.SendUsingAccount = oAccount
.Display
End With
Exit For
End If
Next oAccount
Set oAccount = Nothing
Set objItem = Nothing
Set oMail = Nothing
lbl_Exit:
Exit Sub
End Sub

[OldRelic115]

Thank you very much for providing that. Can I assume from the code you supplied that the way that I was trying to do it, changing the SendUsingAccount in the ItemSend event, cannot be made to work? I had hoped that approach would permit me to use the original Send button and accomplish the same results. I had created a form to select the send account but found that changing the SendUsingAccount that way didn't work.

[gmayor]

I supplied you with the code I use myself to save re-inventing the wheel. I took you at your word that the process you were trying did not work.

[OldRelic115]

Once again, thank you for the help.

[gmayor]

I forgot the code for the userform :(

Option Explicit

Private Sub ListBox1_Click()
If Me.ListBox1.ListIndex > -1 Then
Me.CommandButton1.Enabled = True
End If
lbl_Exit:
Exit Sub
End Sub

Private Sub UserForm_Initialize()
Me.CommandButton1.Enabled = False
lbl_Exit:
Exit Sub
End Sub

Private Sub CommandButton1_Click()
Me.Hide
Me.Tag = 1
lbl_Exit:
Exit Sub
End Sub

Private Sub CommandButton2_Click()
Me.Hide
Me.Tag = 0
lbl_Exit:
Exit Sub
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then Cancel = True
lbl_Exit:
Exit Sub
End Sub