PDA

View Full Version : Excel VBA attaching print area as PDF



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

austenr
08-16-2018, 12:00 PM
Sub CDO_Mail_Small_Text() Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
' .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill in your SMTP server here"
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With

strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"

With iMsg
Set .Configuration = iConf
.To = "ron@debruin.nl"
.CC = ""
.BCC = ""
.From = """Ron"" <ron@something.nl>"
.Subject = "Important message"
.TextBody = strbody
.Send
End With

Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
End SubNote: If you get this error : The transport failed to connect to the server

then try to change the SMTP port from 25 to 465