在Exchange環境中從Excel發送電子郵件

Question

我有一個用戶表單，可以幫助不同的用戶將數據填入電子表格中。一旦數據被插入，它也應該通過電子郵件發送給幾個收件人，具體取決於表單中填寫的選項。

這發生在使用Exchange的企業環境中。我會爲此文件創建一個新的電子郵件帳戶，以便能夠將該電子郵件作爲實體發送，而不使用用戶的電子郵件帳戶。

這可能嗎？怎麼樣？我已經搜索了它，所有我能找到的是如何創建用戶從他的帳戶發送的郵件。

Answer 1

我用下面的代碼（source）從Excel-VBA發送電子郵件。我只用自己的電子郵件帳戶進行了測試，但我認爲只要用戶有權從Exchange服務器上的該帳戶發送郵件，就可以從其他帳戶發送郵件（msgOne.from = ...）。

Dim cdoConfig 
Dim msgOne 

Set cdoConfig = CreateObject("CDO.Configuration") 
With cdoConfig.Fields 
    .Item(cdoSendUsingMethod) = cdoSendUsingPort 
    .Item(cdoSMTPServerPort) = 25 '465 ' (your port number) usually is 25 
    .Item(cdoSMTPServer) = "smtp.mysmtpserver.com" ' your SMTP server goes here 
    '.Item(cdoSendUserName) = "My Username" 
    '.Item(cdoSendPassword) = "myPassword" 
    .Update 
End With 

Set msgOne = CreateObject("CDO.Message") 
Set msgOne.Configuration = cdoConfig 
msgOne.To = "someone@somewhere.com" 
msgOne.from = "me@here.com" 
msgOne.subject = "Test CDO" 
msgOne.TextBody = "It works just fine." 
msgOne.Send 

不幸的是，我目前無法測試這個假設，因爲我只設置了從一個帳戶發送。讓我知道它是如何工作的！

Answer 2

爲什麼不使用Outlook對象模型？

您可以授予當前用戶代表指定用戶發送的權利，然後在呼號MailItem.Send之前設置MailItem.SentOnBehalfOfName和MailItem.ReplyRecipients（如有必要）屬性。

Answer 3

如果excel應用程序在帶有outlook的機器上運行，則可以採用以下方法。

Function SendEmailWithOutlook(er As emailRecord, 
      recipients As String, 
      cc As String, 
      subject As String, 
      body As String, 
      attachmentPath As String) As Boolean 
    Dim errorMsg As String 
    Dim OutApp As Object 
    Dim OutMail As Object 
    Set OutApp = CreateObject("Outlook.Application") 
    Set OutMail = OutApp.CreateItem(0) 
    On Error GoTo errHandle 
    If (er.useTestEmail = True) Then 
     recipients = er.emailTest 
     cc = er.emailTest 
    End If 
    With OutMail 
     If er.emailFrom <> "" Then 
      .sentOnBehalfOfName = er.emailFrom 
     End If 
     .To = recipients 
     .cc = cc 
     .bcc = er.emailBcc 
     .subject = subject 
     .htmlBody = body 
     If attachmentPath <> "" Then 
      .Attachments.Add attachmentPath 
     End If 
     .Send 'or use .Display 
    End With 
    On Error GoTo 0 

    Set OutMail = Nothing 
    Set OutApp = Nothing 
    SendEmailWithOutlook = True 
    Exit Function 
errHandle: 
    errorMsg = "Error sending mail via outlook: " & Err.Description & vbCrLf 
    errorMsg = errorMsg & "OnBehalfOf:" & er.emailFrom & vbCrLf 
    errorMsg = errorMsg & "Recipients: " & recipients & vbCrLf 
    errorMsg = errorMsg & "CC: " & cc & vbCrLf 
    errorMsg = errorMsg & "BCC: " & er.emailBcc 
    MsgBox errorMsg 
    SendEmailWithOutlook = False 
End Function 

添加引用到Microsoft Outlook 14.0對象庫