Как прикрепить созданный .pdf к телу электронной почты с помощью VBA - PullRequest
Новая
       20

Как прикрепить созданный .pdf к телу электронной почты с помощью VBA

0 голосов
/ 04 февраля 2019

У меня есть конвертированный документ из .docx в .pdf, сохраненный на рабочем столе.Последняя задача - прикрепить этот .pdf к телу письма;подпись HTML должна оставаться неизменной.

Мне кажется, проблема в этой строке кода, и я не знаю, как ее исправить: 

.Attachments.Add PdfFile.FullName

Полный код: 

Public Sub Mail()
    Dim LastAuthor As String
        LastAuthor = ActiveDocument.BuiltInDocumentProperties("last Author")

        Dim Email As String
            Email = Replace(LastAuthor, " ", ".") & "@xyz.ro"


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .Display
        .Signature = "HTMLbody"
        .To = Email
        .CC = ""
        .BCC = ""
        .Subject = ActiveDocument.Name
        '.Body = "AVIZAT. Multumesc mult"
        '.Attachments.Add ActiveDocument.FullName
        ' You can add other files by uncommenting the following line.
        '.Attachments.Add ("C:\test.txt")
        ' In place of the following statement, you can use ".Display" to
        ' display the mail.
        .HTMLbody = "AVIZAT, esantionul este in ordine. Multumesc" & "<br>" & .HTMLbody

        Dim objDoc As Document
        Set objDoc = ActiveDocument
        objDoc.ExportAsFixedFormat _
        OutputFileName:=Replace(objDoc.FullName, ".docx", ".pdf"), _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, _
        Range:=wdExportAllDocument, Item:=wdExportDocumentContent
        ' Add the attachment first for correct attachment's name with non English symbols
        .Attachments.Add PdfFile.FullName
        '.Preview 'Preview the email must disable .send & MsgBox (or use .Send to send it)
        .send
        MsgBox "E-mail trimis cu succes"

    Set OutMail = Nothing
    Set OutApp = Nothing

    End With

End Sub

1 Ответ

0 голосов
/ 04 февраля 2019

Это подойдет: 

Public Sub Mail()

    Dim LastAuthor As String
    Dim Email As String
    Dim MyPdfName As String
    Dim objDoc As Document

    LastAuthor = ActiveDocument.BuiltinDocumentProperties("last Author")
    Email = Replace(LastAuthor, " ", ".") & "@xyz.ro"

    Set objDoc = ActiveDocument
    MyPdfName = Replace(objDoc.FullName, ".docx", ".pdf")
    objDoc.ExportAsFixedFormat _
    OutputFileName:=MyPdfName, _
    ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, _
    Range:=wdExportAllDocument, Item:=wdExportDocumentContent

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .Display
        .To = Email
        .CC = ""
        .BCC = ""
        .Subject = objDoc.Name
        .HTMLBody = "<BODY style=font-size:12pt;font-family:Calibri>Servus<br>Esantionul este in ordine.<br><br>Multumesc,<br>" & .HTMLBody
        .Attachments.Add MyPdfName
        .Send
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

    MsgBox "E-mail trimis cu succes"

End Sub

Это далеко от совершенства, но теперь намного понятнее и, самое главное, работает.

...