Excel VBA将打印区域附加为PDF

时间:2018-08-14 17:11:48

标签: excel vba email email-attachments cdo

我正在尝试创建一个宏,以便将工作表“酒店预订”的打印区域作为PDF文件附加到电子邮件中。该电子邮件将使用CDO而非Outlook Application创建。除附件外,我代码中的其他所有内容均有效。它会说找不到文件,并且不会在电子邮件中附加任何内容。

这是我的代码:

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 个答案:

没有答案