• Skip to main content
  • Skip to header right navigation
  • Skip to site footer

My Online Training Hub

Learn Dashboards, Excel, Power BI, Power Query, Power Pivot

  • Courses
  • Pricing
    • Free Courses
    • Power BI Course
    • Excel Power Query Course
    • Power Pivot and DAX Course
    • Excel Dashboard Course
    • Excel PivotTable Course – Quick Start
    • Advanced Excel Formulas Course
    • Excel Expert Advanced Excel Training
    • Excel Tables Course
    • Excel, Word, Outlook
    • Financial Modelling Course
    • Excel PivotTable Course
    • Excel for Customer Service Professionals
    • Excel for Operations Management Course
    • Excel for Decision Making Under Uncertainty Course
    • Excel for Finance Course
    • Excel Analysis ToolPak Course
    • Multi-User Pricing
  • Resources
    • Free Downloads
    • Excel Functions Explained
    • Excel Formulas
    • Excel Add-ins
    • IF Function
      • Excel IF Statement Explained
      • Excel IF AND OR Functions
      • IF Formula Builder
    • Time & Dates in Excel
      • Excel Date & Time
      • Calculating Time in Excel
      • Excel Time Calculation Tricks
      • Excel Date and Time Formatting
    • Excel Keyboard Shortcuts
    • Excel Custom Number Format Guide
    • Pivot Tables Guide
    • VLOOKUP Guide
    • ALT Codes
    • Excel VBA & Macros
    • Excel User Forms
    • VBA String Functions
  • Members
    • Login
  • Blog
  • Excel Webinars
  • Excel Forum
    • Register as Forum Member

VBA auto email in Excel file format|VBA & Macros|Excel Forum|My Online Training Hub

You are here: Home / VBA auto email in Excel file format|VBA & Macros|Excel Forum|My Online Training Hub

vba course banner

Avatar
sp_LogInOut Log In sp_Registration Register
sp_Search Search
Advanced Search
Search
Forum Scope




Match



Forum Options



Minimum search word length is 3 characters - maximum search word length is 84 characters
sp_Search Search
sp_RankInfo
Lost password?
sp_CrumbsHome HomeExcel ForumVBA & MacrosVBA auto email in Excel file format
sp_PrintTopic sp_TopicIcon
VBA auto email in Excel file format
Avatar
David_Ng
Member
Members
Level 0
Forum Posts: 306
Member Since:
December 5, 2016
sp_UserOfflineSmall Offline
1
February 3, 2021 - 2:12 pm
sp_Permalink sp_Print

The following VB codes work fine to send pdf file to individual recipient based on Pivot Fields, deep thanks to  Philip.

But, can these codes be modified  send pivot field filtered range in Excel File format, not pdf format  to recipient.

 

 

Option Explicit

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

    ' *****     You Can Change The Values of These Variables    *********
    EmailSubject = "Outstanding POs copy in NAS " '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("Pivot Table").PivotTables("PivotTable1")
    pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
    pt.PivotCache.Refresh
   
    Set pf = pt.PivotFields("PIC")
   
    Set OutlookApp = CreateObject("Outlook.Application")

    ' Setup the sheet to print one 1 page
    Application.PrintCommunication = False
   
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$3:$3"
        .FitToPagesWide = 15
        .FitToPagesTall = 15
        .Orientation = xlLandscape
         .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
               
    End With
   
    Application.PrintCommunication = True

    ' Go through every Staff 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 Staff 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 GoTo 0
       
        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
       
        ''On Error GoTo 0
        On Error Resume Next
                  
        '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
            
.htmlbody = "<p style=""font-family:Times New Roman Bold;font-style:italic;font-size:18px;"">Dear POs PIC,</p>"
.htmlbody = .htmlbody & "<p style=""font-family:Times New Roman Bold;font-style:italic;font-size:16px;"">Good day !</p>"
.htmlbody = .htmlbody & "<p style=""font-family:Times New Roman Bold;font-style:italic;font-size:16px;"">Attached please subject list as of today, please help to store the POs soonest.</p>"
.htmlbody = .htmlbody & "<span style=""font-family:Times New Roman Bold;font-style:italic;font-size:16px;"">Best Regards,</span><br/>"
.htmlbody = .htmlbody & "<span style=""font-family:Times New Roman Bold;font-size:16px;"">David</span><br/>"
.htmlbody = .htmlbody & "<span style=""font-family:Times New Roman Bold;font-size:18px;"">ABC  Ltd.</span>"

            .Display
            .To = WorksheetFunction.VLookup(Range("B1").Value, Worksheets("Staffs").Range("Managers"), 2, False)
            'To = WorksheetFunction.VLookup(Range("B2").Value, Worksheets("Staffs").Range("Staffs"), 2)
            '.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 = True 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

Avatar
Catalin Bombea
Iasi, Romania
Admin
Level 10
Forum Posts: 1826
Member Since:
November 8, 2013
sp_UserOfflineSmall Offline
2
February 4, 2021 - 2:56 pm
sp_Permalink sp_Print

Here is an example that is using a RangeToHTML function, you can use it to pass the pivot range to email body.

Avatar
David_Ng
Member
Members
Level 0
Forum Posts: 306
Member Since:
December 5, 2016
sp_UserOfflineSmall Offline
3
February 5, 2021 - 9:48 am
sp_Permalink sp_Print

Will have a go, deep thanks Catalin..

sp_Feed
Go to top
Forum Timezone: Australia/Brisbane
Most Users Ever Online: 245
Currently Online: Louis Muti
Guest(s) 9
Currently Browsing this Page:
1 Guest(s)
Top Posters:
SunnyKow: 1432
Anders Sehlstedt: 873
Purfleet: 414
Frans Visser: 346
David_Ng: 306
lea cohen: 222
Jessica Stewart: 218
A.Maurizio: 202
Aye Mu: 201
jaryszek: 183
Newest Members:
Blair Gallagher
Brandi Taylor
Hafiz Ihsan Qadir
Gontran Bage
adolfo casanova
Annestine Johnpulle
Priscila Campbell
Jeff Mikles
Aaron Butler
Maurice Petterlin
Forum Stats:
Groups: 3
Forums: 24
Topics: 6369
Posts: 27852

 

Member Stats:
Guest Posters: 49
Members: 32359
Moderators: 3
Admins: 4
Administrators: Mynda Treacy, Philip Treacy, Catalin Bombea, FT
Moderators: MOTH Support, Velouria, Riny van Eekelen
© Simple:Press —sp_Information

Sidebar

Blog Categories

  • Excel
  • Excel Charts
  • Excel Dashboard
  • Excel Formulas
  • Excel PivotTables
  • Excel Shortcuts
  • Excel VBA
  • General Tips
  • Online Training
  • Outlook
  • Power Apps
  • Power Automate
  • Power BI
  • Power Pivot
  • Power Query
microsoft mvp logo
trustpilot excellent rating
Secured by Sucuri Badge
MyOnlineTrainingHub on YouTube Mynda Treacy on Linked In Mynda Treacy on Instagram Mynda Treacy on Twitter Mynda Treacy on Pinterest MyOnlineTrainingHub on Facebook
 

Company

  • About My Online Training Hub
  • Disclosure Statement
  • Frequently Asked Questions
  • Guarantee
  • Privacy Policy
  • Terms & Conditions
  • Testimonials
  • Become an Affiliate

Support

  • Contact
  • Forum
  • Helpdesk - For Technical Issues

Copyright © 2023 · My Online Training Hub · All Rights Reserved. Microsoft and the Microsoft Office logo are trademarks or registered trademarks of Microsoft Corporation in the United States and/or other countries. Product names, logos, brands, and other trademarks featured or referred to within this website are the property of their respective trademark holders.