vba - Change Sender email address to another email address - Stack Overflow

admin管理员组

文章数量:1416082

I'm trying to change the sender's email address to my secondary email address in Outlook.

The sender should change if an attachment's name includes a specific "attachment_name".

I tried the Application_ItemSend event. It is 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 sending from the wrong address.

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 trying to change the sender's email address to my secondary email address in Outlook.

The sender should change if an attachment's name includes a specific "attachment_name".

I tried the Application_ItemSend event. It is 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 sending from the wrong address.

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

Share Improve this question Follow edited Mar 18 at 11:11 CommunityBot 111 silver badge asked Feb 4 at 8:47 OleOle 1

Add a comment  | 

1 Answer 1

Sorted by: Reset to default 2

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

本文标签： vbaChange Sender email address to another email addressStack Overflow