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