選擇從哪個帳戶發送Outlook電子郵件？

Question

我有這段代碼使用Outlook發送電子郵件。 我的Outlook中有多個電子郵件帳戶，我正在嘗試添加一種方式，以便我可以告訴它從哪個電子郵件地址發送郵件？ 有人可以告訴我我該怎么做嗎？

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Column = Range("AS1").Column Then
  If Target.Row > 7 And Target.Value = "Send Email" Then
    Range("AU" & Target.Row).Value = Date
  End If
  End If

  If Target.Column = Range("CD1").Column Then
  If Target.Row > 7 And Target.Value = "Notify" Then

  Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Dear " & Range("AE" & ActiveCell.Row) & "," & vbNewLine & vbNewLine & _
              "This is an automated email, sent to you by the purchasing department." & vbNewLine & _
              "We have an update on the status of your New Supplier Request. Please see the information below." & vbNewLine & vbNewLine & _
              "Supplier Name: " & Range("B" & ActiveCell.Row) & vbNewLine & _
              "Supplier Reference Number: " & Range("AG" & ActiveCell.Row) & vbNewLine & _
              "Supplier Status: " & Range("D" & ActiveCell.Row) & vbNewLine & vbNewLine & _
              "Description:" & vbNewLine & _
              "We have successfully recieved your application and we have sent out our required documents to the supplier. Once these have been returned we will contact you with a further update. If you have any queries, please contact us at Purchasing@hewden.co.uk." & vbNewLine & vbNewLine & _
              "What does this mean?" & vbNewLine & _
              "We ask that all New Suppliers be registered to allow us to manage a more efficient supply chain. Right now you don't need to do anything else, we will contact the supplier and gather any additional information which we need. Please keep a note of your reference number in the event you should have any enquiries." & vbNewLine & vbNewLine & _
              "Kind Regards," & vbNewLine & _
              "Automated Purchasing Email"

    On Error Resume Next
    With OutMail
        .to = Range("AF" & ActiveCell.Row)
        .CC = "something@something.com"
        .BCC = ""
        .Subject = "New Supplier Request - Update"
        .Body = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0



 End If
  End If


  End Sub

Answer 1

如果您使用多個POP3 / SMTP帳戶，請將MailItem.SendUsingAccount屬性設置為Namespace.Accounts集合中的帳戶之一。

如果使用Exchange，請設置MailItem.SentOnBehalfOfName屬性-您必須具有顯式權限才能代表該用戶發送。

Answer 2

嘗試這個

With OutMail
        .SentOnBehalfOfName = "YourEmailAccount@Email.com"
        .to = Range("AF" & ActiveCell.Row)
        .CC = "something@something.com"
        .BCC = ""
        .Subject = "New Supplier Request - Update"
        .Body = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With