VBA Code to automatically create pdf file based on cell input and then automatically email

[Hazelnut]

Here's my code so far, but I do not know where to enter the pdf portion or even how to begin to add the pdf portion. When I send the email now it strips the data out of the Excel spreadsheet.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRgPre As Range
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Range("P20")
Set xRgPre = xRg.Precedents
If xRg.Value > 2999.99 Then
If Target.Address = xRg.Address Then
Call Mail_small_Text_Outlook
ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) Then
Call Mail_small_Text_Outlook
End If
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Attached is the order. Have a wonderful day!" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = "hazelnut@garden.com"
.CC = ""
.BCC = ""
.Subject = "Form Submission"
.Body = xMailBody
.Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

 

[Hazelnut]

The link doesn't pull anything up.

 

[Miveld]

Sorry to bump an old thread, i have looked through 26 pages on the original thread and this one
Hoping someone can help me out

Everything works fine with the exception that the PDF is created in portrait over 3 pages
I need it to be landscape on 1 page (I have set this as a print area)

Range requried is on a worksheet named "Output"
Range is B4:V20

Thanks in Advance

Sub AttachActiveSheetPDF()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object

' Not sure for what the Title is
Title = Range("A1")

' Define PDF filename
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"

' Export activesheet as PDF
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With

' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0

' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)

' Prepare e-mail
.Subject = Title
.To = "..." ' <-- Put email of the recipient here
.CC = "..." ' <-- Put email of 'copy to' recipient here
.Body = "Hi," & vbLf & vbLf _
& "The report is attached in PDF format." & vbLf & vbLf _
& "Regards," & vbLf _
& Application.UserName & vbLf & vbLf
.Attachments.Add PdfFile

' Try to send
On Error Resume Next
.Send
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent", vbExclamation
Else
MsgBox "E-mail successfully sent", vbInformation
End If
On Error GoTo 0

End With

' Delete PDF file
Kill PdfFile

' Quit Outlook if it was created by this code
If IsCreated Then OutlApp.Quit

' Release the memory of object variable
Set OutlApp = Nothing

End Sub