I'm trying to create a macro whereby the print area of a sheet, "Hotel Booking" is attached as a PDF file to an email. The email will be created using CDO and not Outlook Application. Everything else in my code works except for the attachment. It will say file not found and will not attach anything to the email.
Here's my code that only focuses on the email attachment:
Code
'PDF file for each print range is temporarily saved in same folder as this workbook
destFolder = ThisWorkbook.Path & "\"
If Right(destFolder, 1) <> "\" Then destFolder = destFolder & "\"
If Sheets("Hotel Booking").PageSetup.PrintArea <> "" Then
'Save print area for this sheet as a PDF file
PdfFile = destFolder & Sheets("Hotel Booking").Range("C4") & Sheets("Hotel Booking").Range("C11") & Sheets("Hotel Booking").Name & ".pdf"
Set printRange = Range(Sheets("Hotel Booking").PageSetup.PrintArea)
printRange.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'After code to send
Kill PdfFile
Display More
Here's the whole code:
Code
Sub CDO_Mail_Small_Text()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Dim PdfFile As String
Dim printRange As Range
Dim i As Long
Dim destFolder As String
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
'PDF file for each print range is temporarily saved in same folder as this workbook
destFolder = ThisWorkbook.Path & "\"
If Right(destFolder, 1) <> "\" Then destFolder = destFolder & "\"
If Sheets("Hotel Booking").PageSetup.PrintArea <> "" Then
'Save print area for this sheet as a PDF file
PdfFile = destFolder & Sheets("Hotel Booking").Range("C4") & Sheets("Hotel Booking").Range("C11") & Sheets("Hotel Booking").Name & ".pdf"
Set printRange = Range(Sheets("Hotel Booking").PageSetup.PrintArea)
printRange.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
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") = "[email protected]"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxx"
.Update
End With
With iMsg
Set .Configuration = iConf
.To = "[email protected]"
.CC = ""
.BCC = ""
.From = " <[email protected]>"
.Subject = "Important"
.TextBody = "Hi"
.AddAttachment PdfFile
.Send
End With
Kill PdfFile
End If
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
Display More
Also asked this question here:
http://www.vbaexpress.com/forum/showthre…3039#post383039
https://stackoverflow.com/questions/5184…int-area-as-pdf