使用Excel VBA從Outlook發送富文本電子郵件

Question

我在宏中使用以下（部分）代碼來使用Excel VBA發送Outlook電子郵件。

Function send_mail_rich_text(ByVal send_to As String, ByVal mail_subject As String, ByVal mail_content As Range, ByVal cc_list As String, ByVal bcc_list As String, ByVal rr As String) As String

Set psht = ActiveSheet

Err.Number = 0

If LCase(rr) = "yes" Then
    rr_boo = True
Else
    rr_boo = False
End If

Set oOlApp = CreateObject("Outlook.Application")

olMailItem = 0
Set oOlMItem = oOlApp.CreateItem(olMailItem)

'get Excel cell range which shall be in the mail
Set oWB = ActiveWorkbook
Set oWS = Range("mail.content").Worksheet
oWS.Activate
Set oRange = mail_content

oRange.Copy ' Range is now in Clipboard

On Error Resume Next

Dim oWdDoc As Object

With oOlMItem
    '.Display
    .To = send_to
    .CC = cc_list
    .BCC = bcc_list
    .Subject = mail_subject
    .ReadReceiptRequested = rr_boo

    Set oOlInsp = .GetInspector
    Set oWdDoc = oOlInsp.WordEditor ' get Word Document from the MailBody
    olFormatRichText = 3
    .bodyformat = olFormatRichText ' change to RichTextFormat

    Set oWdRng = oWdDoc.Paragraphs(oWdDoc.Paragraphs.Count).Range        
    oWdRng.Paste ' paste Excel range from Clipboard

    Set oWdRng = oWdDoc.Paragraphs(oWdDoc.Paragraphs.Count).Range

    .send

End With

Application.CutCopyMode = False

If Err.Number <> 0 Then
    save_mail_rich_text = "error"
Else
    save_mail_rich_text = "sent"
End If

psht.Activate

End Function

但是，在“ Set oWdDoc = oOlInsp.WordEditor ”行上出現編譯錯誤。 錯誤顯示“ Function call on the left-hand side of assignment must return Variant or Object ”。 此外，奇怪的是我有兩個具有完全相同代碼的宏，除了一個宏發送而另一個保存草稿。 僅在發送宏的情況下才會發生編譯錯誤。 我在這里想念的是什么？

Answer 1

請嘗試以下方法：

Function send_mail_rich_text(ByVal send_to As String, ByVal mail_subject As String, _
    ByVal mail_content As Range, ByVal cc_list As String, ByVal bcc_list As String, _
    ByVal rr As Boolean) As String

    Dim oOlApp As Object    ' Outlook.Application
    Dim oOlMItem As Object  ' Outlook.MailItem
    Dim oWdDoc As Object    ' Word.Document

    Err.Clear

    Set oOlApp = CreateObject("Outlook.Application")
    Set oOlMItem = oOlApp.CreateItem(olMailItem)

    ' Range can be copied directly as given as Range via function call
    mail_content.Copy

    ' On Error Resume Next   ' activate it after debugging
    With oOlMItem
        .To = send_to
        .CC = cc_list
        .BCC = bcc_list
        .Subject = mail_subject
        .ReadReceiptRequested = rr ' can be used directly if given as boolean
        .BodyFormat = 3 ' 3=RichTextFormat

        Set oWdDoc = .GetInspector.WordEditor

        ' by this you paste below your signature
        ' oWdDoc.Paragraphs(oWdDoc.Paragraphs.Count).Range.Paste

        ' by these alternatives you paste before your signature
        oWdDoc.Range(oWdDoc.Content.Start, oWdDoc.Content.Start).Paste
        oWdDoc.Bookmarks("\StartOfDoc").Range.Paste

        .Display ' change to .Send after debugging
    End With

    Application.CutCopyMode = False

    If Err.Number <> 0 Then
        send_mail_rich_text = "error"
    ElseIf oOlMItem.Sent = True Then
        send_mail_rich_text = "sent"
    Else
        send_mail_rich_text = "no error, but not sent"
    End If
End Function

由於ReadReceiptRequested應該為布爾值，因此我在函數調用中對其進行了更改。 請注意相應地更改對此函數的調用。 我對此進行了測試：

Private Sub TestSendmailFunction()
    Debug.Print send_mail_rich_text("to@test.com", "Test", ActiveSheet.Range("B2:C3"), _
        "cc@test.com", "bcc@test.com", False)
End Sub

當您將“ mail_content”設置為范圍時，不必切換到另一張紙，也不必稍后再回到上一張紙。 范圍也可以直接從非活動工作表中復制。

您應該在每個VBA模塊的開頭使用Option Explicit ，以防止類似“ send_mail_rich_text”和“ save_mail_rich_text”之類的錯誤或諸如oWdRng之類的未知對象。

如果您不再需要該對象，則可以組合命令：代替Set oWdRng = ...和oWdRng.Paste ，可以使用整個部分： ....Paste 。

如果可以添加對“ Microsoft Excel xx對象庫”和“ Microsoft Word xx對象庫”的引用，則可以通過例如Outlook.Mailitem交換Object ，以通過“早期綁定”提供更多調試功能。 然后，預定義的常量olFormatRichText （來自內部ENUM OlBodyFormat）也是已知的，可以直接使用。