Send email using pivot table and VBA

BODYCOTE

New Member
Joined
May 18, 2021
Messages
13
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Hello,

I am currently using the below vba to send orders from my pivot table through outlook, but I want to know what I need to change to allow me to have a pre-written body for the email, without losing the default signature that outlook is using.

Thanks for any help.

Option Explicit

' Written by Philip Treacy - MyOnlineTrainingHub
' https://www.myonlinetraininghub.com/automating-emailing-pivot-table-reports

Sub EmailPTReports()

Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim i As Long
Dim EmailSubject As String
Dim PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim DisplayEmail As Boolean
Dim OutlookApp As Object, OutlookMail As Object
Dim strbody As String

' ***** You Can Change The Values of These Variables *********
EmailSubject = "Order" 'Change this to change the subject of the email.
DisplayEmail = True 'Change this if you don't want to display the email before sending. Note, you must have a TO email address specified for this to work
Email_To = "" 'Change this if you want to specify To email e.g. ActiveSheet.Range("H1") to get email from cell H1
Email_CC = ""
Email_BCC = ""
' ******************************************************

Set pt = Sheets("PURCHASE ORDER BY SUPPLIER").PivotTables("PivotTable2")
pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
pt.PivotCache.Refresh

Set pf = pt.PivotFields("SUPPLIER NAME")

Set OutlookApp = CreateObject("Outlook.Application")


' Setup the sheet to print one 1 page
Application.PrintCommunication = False

With ActiveSheet.PageSetup

.FitToPagesWide = 1
.FitToPagesTall = 1
.Orientation = xlPortrait

End With

Application.PrintCommunication = True

' Go through every category in turn
For i = 1 To pf.PivotItems.Count

pf.CurrentPage = pf.PivotItems(i).Name
PDFFile = Environ("Temp") & Application.PathSeparator & pf.PivotItems(i).Name & ".pdf"

' Replace / in category name as this is an invalid character for filenames
PDFFile = Replace(PDFFile, "/", "_")

' Delete PDFFile if it already exists so that
' we can create new file later with the same name
On Error Resume Next
If Len(Dir(PDFFile)) > 0 Then Kill PDFFile

' If there's an error deleting the file
If Err.Number <> 0 Then

MsgBox "Unable to delete " & PDFFile & ". Please make sure the file is not open or write protected." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"

Exit Sub

End If

' Reset error handling to normal
On Error GoTo 0

'Create the PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

'Create a new mail message
Set OutlookMail = OutlookApp.CreateItem(0)

'Display email and specify To, Subject, etc
With OutlookMail

.Display
.To = WorksheetFunction.VLookup(Range("C5").Value, Worksheets("SUPPLIERS").Range("TABLE6"), 3)
'.CC = Email_CC
'.BCC = Email_BCC
.Subject = EmailSubject
.Attachments.Add PDFFile

' Change this to True to automatically send emails without first viewing them
If DisplayEmail = False Then

.Send

End If

End With

' Delete the temp file we just created
Kill PDFFile

Next i

' Tidy up
Set OutlookApp = Nothing
Set OutlookMail = Nothing

End Sub
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

Forum statistics

Threads
1,144,339
Messages
5,723,801
Members
422,518
Latest member
quack_quack

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top