Auto email sending when no data present


Board Regular
Feb 16, 2016
Hi all,

I have the below code put together using Ron de bruin and the helpful members here (thank you). It is almost finished. I have a main data tab then a master pivot tab, then separate tabs for each customer containing a pivot filtered on the individual customer. The code works great, however when there is no data for one customer it still sends an email with just the pivot headers and no data (as there is nothing in the main data tab). Is there any way of not sending an email if the pivot has no data? my code is as follows

VBA Code:
Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _
                 OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    Dim FileFormatstr As String
    Dim Fname As Variant

    'Test to see if the Microsoft Create/Send add-in is installed.
    If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
         & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then

        If FixedFilePathName = "" Then
            'Open the GetSaveAsFilename dialog to enter a file name for the PDF file.
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
                  Title:="Create PDF")

            'If you cancel this dialog, exit the function.
            If Fname = False Then Exit Function
            Fname = FixedFilePathName
        End If

        'If OverwriteIfFileExist = False then test to see if the PDF
        'already exists in the folder and exit the function if it does.
        If OverwriteIfFileExist = False Then
            If Dir(Fname) <> "" Then Exit Function
        End If

        'Now export the PDF file.
        On Error Resume Next
        Myvar.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                FileName:=Fname, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
        On Error GoTo 0

        'If the export is successful, return the file name.
        If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
    End If
End Function

Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
                              StrSubject As String, StrBody As String, Send As Boolean)
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = StrTo
        .CC = ""
        .BCC = ""
        .Subject = StrSubject
        .Body = StrBody
        .Attachments.Add FileNamePDF
        If Send = True Then
        End If
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Function

Sub Mail_Every_Worksheet_With_Address_In_A1_PDF()
'This example works in Excel 2007 and Excel 2010.
    Dim sh As Worksheet
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileName As String

    'Set a temporary path to save the PDF files.
    'You can also use another folder similar to
    'TempFilePath = "C:\Users\Ron\MyFolder\"
    TempFilePath = Environ$("temp") & "\"

    'Loop through each worksheet.
    For Each sh In ThisWorkbook.Worksheets
        FileName = ""

        'Test A1 for an e-mail address.
        If sh.Range("A1").Value Like "?*@?*.?*" Then

            'If there is an e-mail address in A1, create the file name and the PDF.
            TempFileName = TempFilePath & "Sheet " & sh.Name & " of " _
                         & ThisWorkbook.Name & " " _
                         & Format(Now, "dd-mmm-yy h-mm-ss") & ".pdf"

            FileName = RDB_Create_PDF(sh, TempFileName, True, False)

            'If publishing is set, create the mail.
            If FileName <> "" Then
    RDB_Mail_PDF_Outlook FileName, sh.Range("A1").Value, "Late Loads", _
        "Hello" & vbNewLine & vbNewLine & _
        "Your planned delivery from Corrboard today is running late (please see attached for departure time)." & vbNewLine & vbNewLine & _
        "Once loaded, we will advise new ETA." & vbNewLine & vbNewLine & _
        "All queries relating to these delayed orders should be directed to CorrBoard Customer Services." & vbNewLine & vbNewLine & vbNewLine & _
        "Best regards," & vbNewLine & vbNewLine & _
        "Archbold Logistics", True

                'After the e-mail is created, delete the PDF file in TempFilePath.
                If Dir(TempFileName) <> "" Then Kill TempFileName

                   MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                   "Microsoft Add-in is not installed" & vbNewLine & _
                       "The path to save the file in arg 2 is not correct" & vbNewLine & _
                       "You didn't want to overwrite the existing PDF if it exist"
                End If

            End If
    Next sh
    Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

MsgBox "You have successfully emailed the Late Loads!"
End Sub

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

Forum statistics

Latest member

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