select从哪个帐户发送Outlook电子邮件?

我有这个代码,使用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 

尝试这个

 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 

如果您使用多个POP3 / SMTP帐户,请将MailItem.SendUsingAccount属性设置为Namespace.Accounts集合中的一个帐户。

如果您使用的是Exchange,请设置MailItem.SentOnBehalfOfName属性 – 您必须具有以该用户名义发送的明确权限。