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

时间:2019-01-23 13:49:46

标签: excel vba outlook

我正在宏中使用以下(部分)代码来使用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”。此外,奇怪的是我有两个具有完全相同代码的宏,除了一个宏发送而另一个保存草稿。仅在发送宏的情况下才会发生编译错误。我在这里想念什么?

1 个答案:

答案 0 :(得分:0)

请尝试以下操作:

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 x.x对象库”和“ Microsoft Word x.x对象库”的引用,则可以通过e交换Object。 G。 Outlook.Mailitem通过“早期绑定”提供更多调试功能。然后,也知道预定义的常量olFormatRichText(来自内部ENUM OlBodyFormat),可以直接使用。