如何在Outlook邮件发送VBA宏中指定不同的发件邮箱

要实现从三个可选邮箱中选择发件人，你可以利用Outlook的SendUsingAccount属性，通过匹配对应账户对象来指定发件邮箱。以下是两种可行的修改方案：

方案1：输入邮箱地址选择 #

通过输入框让用户直接填写目标发件邮箱，适合需要灵活输入的场景：

Sub enviar_email()
    Dim objeto_outlook As Object
    Dim Email As Object
    Dim selectedAccount As Object
    Dim senderEmail As String
    
    ' 弹出输入框提示用户选择发件邮箱
    senderEmail = InputBox("请输入要使用的发件邮箱地址（可选：xxx@xxx.com、yyy@yyy.com、zzz@zzz.com）", "选择发件人")
    If senderEmail = "" Then Exit Sub ' 用户取消输入则退出
    
    ' 创建Outlook对象
    Set objeto_outlook = CreateObject("Outlook.Application")
    Set Email = objeto_outlook.CreateItem(0)
    
    ' 匹配对应发件账户
    For Each selectedAccount In objeto_outlook.Session.Accounts
        If selectedAccount.SmtpAddress = senderEmail Then
            Set Email.SendUsingAccount = selectedAccount
            Exit For
        End If
    Next selectedAccount
    
    ' 设置邮件核心内容
    Email.To = Cells(2, 1).Value
    Email.CC = ""
    Email.BCC = ""
    Email.Subject = "Hello Teste"
    Email.Body = Cells(2, 2).Value & "," & Chr(10) & Chr(10) _
                & Cells(2, 3).Value & Chr(10) & Chr(10) _
                & "Thanks" & Chr(10) & "Regards"
    
    ' 添加附件
    Email.Attachments.Add ThisWorkbook.Path & "\Marcelo - " & Cells(2, 4).Value & ".xlsm"
    
    ' 显示邮件
    Email.Display
End Sub

方案2：按钮选择邮箱 #

通过弹窗按钮让用户直观选择，避免输入错误：

Sub enviar_email_with_option()
    Dim objeto_outlook As Object
    Dim Email As Object
    Dim selectedAccount As Object
    Dim senderEmail As String
    Dim choice As Integer
    
    ' 弹出选择弹窗
    choice = MsgBox("选择发件邮箱：" & vbCrLf & _
                   "1. xxx@xxx.com" & vbCrLf & _
                   "2. yyy@yyy.com" & vbCrLf & _
                   "3. zzz@zzz.com", _
                   vbQuestion + vbYesNoCancel, "选择发件人")
    
    ' 根据选择赋值对应邮箱
    Select Case choice
        Case vbYes
            senderEmail = "xxx@xxx.com"
        Case vbNo
            senderEmail = "yyy@yyy.com"
        Case vbCancel
            senderEmail = "zzz@zzz.com"
        Case Else
            Exit Sub ' 用户关闭弹窗则退出
    End Select
    
    ' 创建Outlook对象并匹配账户
    Set objeto_outlook = CreateObject("Outlook.Application")
    Set Email = objeto_outlook.CreateItem(0)
    
    For Each selectedAccount In objeto_outlook.Session.Accounts
        If selectedAccount.SmtpAddress = senderEmail Then
            Set Email.SendUsingAccount = selectedAccount
            Exit For
        End If
    Next selectedAccount
    
    ' 设置邮件内容（同方案1）
    Email.To = Cells(2, 1).Value
    Email.CC = ""
    Email.BCC = ""
    Email.Subject = "Hello Teste"
    Email.Body = Cells(2, 2).Value & "," & Chr(10) & Chr(10) _
                & Cells(2, 3).Value & Chr(10) & Chr(10) _
                & "Thanks" & Chr(10) & "Regards"
    
    Email.Attachments.Add ThisWorkbook.Path & "\Marcelo - " & Cells(2, 4).Value & ".xlsm"
    Email.Display
End Sub

关键说明 #

• 两种方案都依赖SendUsingAccount属性：直接设置Sender可能因权限或配置问题失效，通过匹配Outlook已配置的账户对象是更可靠的方式。
• 需将代码中的xxx@xxx.com等占位符替换为你实际可用的三个邮箱地址。
• 确保目标邮箱已在Outlook中完成账户配置，否则无法匹配到对应的账户对象。

内容的提问来源于stack exchange，提问作者Gustavo Fabrini