Отправка электронной почты в формате RTF с помощью Excel VBA - PullRequest
Новая
       3

Отправка электронной почты в формате RTF с помощью Excel VBA

0 голосов
/ 23 января 2019

Я использую следующий (фрагмент) код в макросе для отправки электронных писем Outlook с использованием 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

Однако я могу получить ошибку компиляции в строке "Set oWdDoc = oOlInsp.WordEditor".Ошибка говорит "Function call on the left-hand side of assignment must return Variant or Object".Кроме того, странная часть состоит в том, что у меня есть два макроса с точно таким же кодом, за исключением того, что один отправляет, а другой сохраняет черновик.Ошибка компиляции происходит только в случае отправки макроса.Что мне здесь не хватает?

1 Ответ

0 голосов
/ 23 января 2019

Пожалуйста, попробуйте это: 

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» в качестве диапазона. Диапазон можно скопировать напрямую и с неактивных листов.

Вы должны использовать Option Explicit в начале каждого модуля VBA, чтобы предотвратить ошибки, такие как «send_mail_rich_text» или «save_mail_rich_text», или неизвестные объекты, такие как oWdRng.

Вы можете комбинировать команды, если вам больше не нужен объект: вместо Set oWdRng = ... и oWdRng.Paste вы можете использовать всю часть: ....Paste.

Если вы можете добавить ссылку на «Библиотеку объектов Microsoft Excel x.x» и «Библиотеку объектов Microsoft Word x.x», то вы можете обменять Object по e. г. Outlook.Mailitem, чтобы обеспечить больше возможностей отладки за счет "раннего связывания". Кроме того, предопределенные константы как olFormatRichText (из внутреннего ENUM OlBodyFormat) известны и могут использоваться напрямую.

...