Automated email from excel

S

sknight22

Board Regular
Joined
Feb 16, 2016
Messages
75
Hello all,

I have an excel file to send out emails based on data entered. I have a raw data tab where I paste information, a master pivot tab and then a tab for each customer which is filtered on their specific data. I have used code from Ron de bruins site to try to send each page as PDF to the address in cell A1 of each sheet, however when I run it I get "Compile Error: Sub or Function not defined" with "RDB_Create_PDF" highlighted in blue. The code i have copied is below - any help would be great thank you.

VBA Code: 
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, "This is the subject", _
                   "See the attached PDF file with the last figures" _
                   & vbNewLine & vbNewLine & "Regards Ron de bruin", False

                '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
End Sub
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Sort by date Sort by votes
Hi sknight22,
as stated on Ron's website, the code you use calls two functions
RDB_Create_PDF and RDB_Mail_PDF_Outlook
you need to add them in your code
VBA Code: 
Function RDB_Create_PDF(Source As Object, FixedFilePathName As String, _
    OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    Dim FileFormatstr As String
    Dim Fname As Variant
    'Ron de Bruin : 26-April-2020

    If FixedFilePathName = "" Then
        'Open the GetSaveAsFilename dialog to enter a file name for the pdf
        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 we test if the PDF
    'already exist in the folder and Exit the function if that is True
    If OverwriteIfFileExist = False Then
        If Dir(Fname) <> "" Then Exit Function
    End If

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    'Now the file name is correct we Publish to PDF
    On Error Resume Next
    Source.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    FileName:=Fname, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=OpenPDFAfterPublish
    On Error GoTo 0

    Application.ScreenUpdating = True
    Application.EnableEvents = True

    'If Publish is Ok the function will return the file name
    If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
End Function



Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
    StrCC As String, StrBCC As String, StrSubject As String, _
    Signature As Boolean, Send As Boolean, StrBody As String)
    Dim OutApp As Object
    Dim OutMail As Object
    'Ron de Bruin : 26-April-2020

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

    On Error Resume Next
    With OutMail
        If Signature = True Then .Display
        .To = StrTo
        .CC = StrCC
        .BCC = StrBCC
        .Subject = StrSubject
        .HTMLBody = StrBody & "<br>" & .HTMLBody
        .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



Function Create_PDF_Sheet_Level_Names(NamedRange As String, FixedFilePathName As String, _
    OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    'This function will create a PDF with every sheet with
    'a sheet level name variable <NamedRange> in it
    'Ron de Bruin : 26-April-2020
    Dim FileFormatstr As String
    Dim Fname As Variant
    Dim Ash As Worksheet
    Dim sh As Worksheet
    Dim ShArr() As String
    Dim s As Long
    Dim SheetLevelName As Name

    'We fill the Array with sheets with the sheet level name variable
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Visible = -1 Then
            Set SheetLevelName = Nothing
            On Error Resume Next
            Set SheetLevelName = sh.Names(NamedRange)
            On Error GoTo 0
            If Not SheetLevelName Is Nothing Then
                s = s + 1
                ReDim Preserve ShArr(1 To s)
                ShArr(s) = sh.Name
            End If
        End If
        Next sh

    'We exit the function If there are no sheets with
    'a sheet level name variable named <NamedRange>
    If s = 0 Then Exit Function

    If FixedFilePathName = "" Then

        'Open the GetSaveAsFilename dialog to enter a file name for the pdf
        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 we test if the PDF
    'already exist in the folder and Exit the function if that is True
    If OverwriteIfFileExist = False Then
        If Dir(Fname) <> "" Then Exit Function
    End If

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    'Remember the ActiveSheet
    Set Ash = ActiveSheet

    'Select the sheets with the sheet level name in it
    Sheets(ShArr).Select

    'Now the file name is correct we Publish to PDF
    On Error Resume Next
    ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    FileName:=Fname, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=OpenPDFAfterPublish
    On Error GoTo 0

    'If Publish is Ok the function will return the file name
    If Dir(Fname) <> "" Then
        Create_PDF_Sheet_Level_Names = Fname
    End If

    Ash.Select

    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Function
 
Upvote 0
Sequoyah said:
Hi sknight22,
as stated on Ron's website, the code you use calls two functions
RDB_Create_PDF and RDB_Mail_PDF_Outlook
you need to add them in your code
VBA Code: 
Function RDB_Create_PDF(Source As Object, FixedFilePathName As String, _
    OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    Dim FileFormatstr As String
    Dim Fname As Variant
    'Ron de Bruin : 26-April-2020

    If FixedFilePathName = "" Then
        'Open the GetSaveAsFilename dialog to enter a file name for the pdf
        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 we test if the PDF
    'already exist in the folder and Exit the function if that is True
    If OverwriteIfFileExist = False Then
        If Dir(Fname) <> "" Then Exit Function
    End If

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    'Now the file name is correct we Publish to PDF
    On Error Resume Next
    Source.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    FileName:=Fname, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=OpenPDFAfterPublish
    On Error GoTo 0

    Application.ScreenUpdating = True
    Application.EnableEvents = True

    'If Publish is Ok the function will return the file name
    If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
End Function



Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
    StrCC As String, StrBCC As String, StrSubject As String, _
    Signature As Boolean, Send As Boolean, StrBody As String)
    Dim OutApp As Object
    Dim OutMail As Object
    'Ron de Bruin : 26-April-2020

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

    On Error Resume Next
    With OutMail
        If Signature = True Then .Display
        .To = StrTo
        .CC = StrCC
        .BCC = StrBCC
        .Subject = StrSubject
        .HTMLBody = StrBody & "<br>" & .HTMLBody
        .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



Function Create_PDF_Sheet_Level_Names(NamedRange As String, FixedFilePathName As String, _
    OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    'This function will create a PDF with every sheet with
    'a sheet level name variable <NamedRange> in it
    'Ron de Bruin : 26-April-2020
    Dim FileFormatstr As String
    Dim Fname As Variant
    Dim Ash As Worksheet
    Dim sh As Worksheet
    Dim ShArr() As String
    Dim s As Long
    Dim SheetLevelName As Name

    'We fill the Array with sheets with the sheet level name variable
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Visible = -1 Then
            Set SheetLevelName = Nothing
            On Error Resume Next
            Set SheetLevelName = sh.Names(NamedRange)
            On Error GoTo 0
            If Not SheetLevelName Is Nothing Then
                s = s + 1
                ReDim Preserve ShArr(1 To s)
                ShArr(s) = sh.Name
            End If
        End If
        Next sh

    'We exit the function If there are no sheets with
    'a sheet level name variable named <NamedRange>
    If s = 0 Then Exit Function

    If FixedFilePathName = "" Then

        'Open the GetSaveAsFilename dialog to enter a file name for the pdf
        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 we test if the PDF
    'already exist in the folder and Exit the function if that is True
    If OverwriteIfFileExist = False Then
        If Dir(Fname) <> "" Then Exit Function
    End If

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    'Remember the ActiveSheet
    Set Ash = ActiveSheet

    'Select the sheets with the sheet level name in it
    Sheets(ShArr).Select

    'Now the file name is correct we Publish to PDF
    On Error Resume Next
    ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    FileName:=Fname, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=OpenPDFAfterPublish
    On Error GoTo 0

    'If Publish is Ok the function will return the file name
    If Dir(Fname) <> "" Then
        Create_PDF_Sheet_Level_Names = Fname
    End If

    Ash.Select

    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Function
Click to expand...
Thank you Sequoyah, I have gone back and amended (code below). This now seems to work, the only snag now is that it opens the email with the PDF attached and the recipient and subject as required but I have to press send. Is there something missing that would allow the email to send auatomatically?



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, "This is the subject", _
                   "See the attached PDF file with the last figures" _
                   & vbNewLine & vbNewLine & "Regards Ron de bruin", False

                '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
End Sub
 
Upvote 0
Hi sknight22
thanks for the feedback, i can't test the code now,
try changing this line
VBA Code: 
RDB_Mail_PDF_Outlook FileName, sh.Range("A1").Value, "This is the subject", _
                   "See the attached PDF file with the last figures" _
                   & vbNewLine & vbNewLine & "Regards Ron de bruin", False
to
Code: 
RDB_Mail_PDF_Outlook FileName, sh.Range("A1").Value, "This is the subject", _
                   "See the attached PDF file with the last figures" _
                   & vbNewLine & vbNewLine & "Regards Ron de bruin", True
 
Upvote 0
Solution
Sequoyah said:
Hi sknight22
thanks for the feedback, i can't test the code now,
try changing this line
VBA Code: 
RDB_Mail_PDF_Outlook FileName, sh.Range("A1").Value, "This is the subject", _
                   "See the attached PDF file with the last figures" _
                   & vbNewLine & vbNewLine & "Regards Ron de bruin", False
to
Code: 
RDB_Mail_PDF_Outlook FileName, sh.Range("A1").Value, "This is the subject", _
                   "See the attached PDF file with the last figures" _
                   & vbNewLine & vbNewLine & "Regards Ron de bruin", True
Click to expand...
Absolutely fantastic, thank you so much this has worked perfectly. massive appreciation for your help Sequoyah
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
Excel VBA to email multiple ranges as a PDF
Replies
0
Views
662
shophoney
S
P
  • Question
Signature is being removed when I run the rest of my VBA
Replies
3
Views
162
rollis13
rollis13
M
  • Question
Creating and emailing Excel sheet with only visible data
Replies
0
Views
166
mecerrato
M
J
  • Question
Kill Temp File
Replies
1
Views
334
ExcelToDAX
E
H
  • Question
Macro to attached sheets without formulas
Replies
2
Views
378
howard
H

Forum statistics

Threads
1,214,808
Messages
6,121,686
Members
449,048
Latest member
81jamesacct

Share this page

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