Auto email sending when no data present

sknight22

Board Regular
Joined
Feb 16, 2016
Messages
75
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
        Else
            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, _
                OpenAfterPublish:=OpenPDFAfterPublish
        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
            .Send
        Else
            .Display
        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

                Else
                   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

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,036
Messages
5,767,766
Members
425,431
Latest member
Sayson

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