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