Excel VBA прикрепление области печати в формате PDF

Я пытаюсь создать макрос, в котором область печати листа "Бронирование отелей" прикрепляется в виде файла PDF к электронному письму. Электронная почта будет создана с использованием CDO, а не приложения Outlook. Все остальное в моем коде работает, кроме вложения. Он скажет, что файл не найден, и не будет ничего прикреплять к письму.

Вот мой код:

Sub CDO_Mail_Small_Text2()    Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Dim PDFfile As String, Title As String
Dim printRange As Range
Dim i As Long

CarryOn = MsgBox("Proceed to compose Email?", vbYesNo, "Continue?")


If CarryOn = vbYes Then


Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")


    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields


Title = Sheets("Hotel Booking").Range("AF17")
PDFfile = ActiveWorkbook.FullName
  i = InStrRev(PDFfile, ".")
  If i > 1 Then PDFfile = Left(PDFfile, i - 1)
  PDFfile = PDFfile & "_" & Sheets("Hotel Booking").Name & ".pdf"

Set printRange = Range(Sheets("Hotel Booking").PageSetup.PrintArea)



With Sheets("Hotel Booking")
    printRange.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp-mail.outlook.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxx@outlook.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxx"
        .Update
    End With


With iMsg
    Set .Configuration = iConf
    .To = "xxxxx@gmail.com"
    .CC = ""
    .BCC = ""
    .From = " <xxxx@outlook.com>"
    .Subject = " "
    .TextBody = " "
    .AddAttachment PdfFile
    .Send
End With

'Kill PdfFile


    Set iMsg = Nothing
    Set iConf = Nothing
    Set Flds = Nothing

    If Err.Number <> 0 Then
     MsgBox "There was an error"
     Exit Sub

    Else
 MsgBox "Email has been sent!"

    End If  'for error

End If   'compose email


End Sub

0 ответов

Другие вопросы по тегам