使用Excel VBA从Outlook发送富文本电子邮件

Question

I am using the following (piece of) code in a macro to send outlook emails using Excel VBA.

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

However, I get can a compile error on the line " Set oWdDoc = oOlInsp.WordEditor ". Error says " Function call on the left-hand side of assignment must return Variant or Object ". Further, the strange part is that I have two macros with the exact same code except that one sends and the other saves draft. The compilation error occurs only in case of send macro. What I am missing here?

Answer 1

Please try this:

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

As ReadReceiptRequested is expected as boolean, I changed it within the function call. Be aware to change your calls to this function accordingly. I tested it with this:

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

It is not necessary to switch to another sheet and later back to the previous one as you give "mail_content" as range. A range can be copied directly also from non-active sheets.

You should use Option Explicit at the beginning of every VBA module to prevent errors like "send_mail_rich_text" vs. "save_mail_rich_text" or unknown objects like oWdRng.

You can combine commands if you don't need the object again: Instead of Set oWdRng = ... and oWdRng.Paste you can use the whole part: ....Paste .

If you can add a reference to "Microsoft Excel xx Object Library" and "Microsoft Word xx Object Library" then you can exchange Object by eg Outlook.Mailitem to provide more debugging features by "early binding". Then also the predefinded constants as olFormatRichText (from internal ENUM OlBodyFormat) are known and can be used directly.