Show all Data After emailing

BODYCOTE

New Member
Joined
May 18, 2021
Messages
13
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
I have the below code that sends orders to multiple suppliers

However once finished the table has a filter remaining that I'd like removed

Also I want to then print the entire worksheet at the end

foot note: sometimes it fails to complete emails and closes excel, would anyone know why?

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


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")



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

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,567
Office Version
  1. 2007
Platform
  1. Windows
However once finished the table has a filter remaining that I'd like removed
Also I want to then print the entire worksheet at the end

Ater this line
Next i

add these lines:
VBA Code:
  pt.ClearAllFilters
  ActiveSheet.PrintOut

foot note: sometimes it fails to complete emails and closes excel, would anyone know why?
I do not know the problem, I did tests and they worked for me.
 

BODYCOTE

New Member
Joined
May 18, 2021
Messages
13
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Thanks, i believe it is setting an automatic line break between each category that I haven't been able to remove so far, however, on my mac it does not have line breaks.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,567
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback.
 

Forum statistics

Threads
1,141,000
Messages
5,703,652
Members
421,308
Latest member
NewBlood

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