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