Forum

VBA auto email in E...
 
Notifications
Clear all

VBA auto email in Excel file format

3 Posts
2 Users
0 Reactions
146 Views
(@david_ng)
Posts: 310
Reputable Member
Topic starter
 

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

 
Posted : 04/02/2021 12:12 am
(@catalinb)
Posts: 1937
Member Admin
 

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

 
Posted : 05/02/2021 12:56 am
(@david_ng)
Posts: 310
Reputable Member
Topic starter
 

Will have a go, deep thanks Catalin..

 
Posted : 05/02/2021 7:48 pm
Share: