quanziee
08-14-2018, 06:09 AM
Hey, 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:
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
Here's my code:
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