我正在尝试创建一个宏,以便将工作表“酒店预订”的打印区域作为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