I'm currently trying to change the sender's email address in VBA to my secondary email in Outlook. The sender should change if an attachment's name includes a specific "attachment_name". I've already tried using the Application_ItemSend event, but it didn't work as expected.

It's sending the email from the default email address, even when I include a "stop" and go step by step. It reaches the point where "account" is defined as the new_sender_email, but it's still sending from the wrong address Here's my attempt:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim mailItem As Outlook.mailItem
    Dim attachment As Outlook.attachment
    Dim smtpAddress As String
    
    If TypeName(Item) <> "MailItem" Then Exit Sub
    Stop
    Set mailItem = Item
    smtpAddress = "new_sender_email"
    
    For Each attachment In mailItem.Attachments
        If InStr(LCase(attachment.FileName), "rechnung") > 0 Then
            mailItem.SentOnBehalfOfName = smtpAddress
            

            If mailItem.SentOnBehalfOfName <> smtpAddress Then
                MsgBox "Error2", vbExclamation
                Cancel = True
            End If
            
            Exit For
        End If
    Next attachment
End Sub

I'm currently trying to change the sender's email address in VBA to my secondary email in Outlook. The sender should change if an attachment's name includes a specific "attachment_name". I've already tried using the Application_ItemSend event, but it didn't work as expected.

It's sending the email from the default email address, even when I include a "stop" and go step by step. It reaches the point where "account" is defined as the new_sender_email, but it's still sending from the wrong address Here's my attempt:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim mailItem As Outlook.mailItem
    Dim attachment As Outlook.attachment
    Dim smtpAddress As String
    
    If TypeName(Item) <> "MailItem" Then Exit Sub
    Stop
    Set mailItem = Item
    smtpAddress = "new_sender_email"
    
    For Each attachment In mailItem.Attachments
        If InStr(LCase(attachment.FileName), "rechnung") > 0 Then
            mailItem.SentOnBehalfOfName = smtpAddress
            

            If mailItem.SentOnBehalfOfName <> smtpAddress Then
                MsgBox "Error2", vbExclamation
                Cancel = True
            End If
            
            Exit For
        End If
    Next attachment
End Sub

• vba
• outlook
• outlook-addin

1 Answer 1

The issue you're facing is due to using the SentOnBehalfOfName property, which is designed for scenarios where you are sending an email on behalf of another person (such as a delegate). Instead, you need to use the SendUsingAccount property to specify which email account should be used for sending the email.

Here's the corrected code:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim mailItem As Outlook.MailItem
    Dim attachment As Outlook.Attachment
    Dim newSenderAccount As Outlook.Account
    Dim smtpAddress As String
    Dim account As Outlook.Account
    Dim accounts As Outlook.Accounts
    Dim found As Boolean

    ' Ensure it's a MailItem
    If TypeName(Item) <> "MailItem" Then Exit Sub
    
    Set mailItem = Item
    smtpAddress = "new_sender_email"  ' Define the new sender's email address
    found = False
    
    ' Get all accounts in Outlook
    Set accounts = Application.Session.Accounts
    
    ' Loop through accounts and find the one that matches the smtpAddress
    For Each account In accounts
        If account.SmtpAddress = smtpAddress Then
            Set newSenderAccount = account
            found = True
            Exit For
        End If
    Next account
    
    ' If the account is found, set the email to send using that account
    If found Then
        mailItem.SendUsingAccount = newSenderAccount
    Else
        MsgBox "Account not found.", vbExclamation
        Cancel = True
    End If
    
    ' Check for attachments and apply condition based on the file name
    For Each attachment In mailItem.Attachments
        If InStr(LCase(attachment.FileName), "rechnung") > 0 Then
            ' Ensure the new sender is correctly applied
            If mailItem.SendUsingAccount Is newSenderAccount Then
                MsgBox "Email will be sent from " & newSenderAccount.DisplayName, vbInformation
            Else
                MsgBox "Error: Unable to change sender.", vbExclamation
                Cancel = True
            End If
            Exit For
        End If
    Next attachment
End Sub