Results 1 to 4 of 4
  1. #1
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts

    Email file in PDF

    I have the following code with I tried to adapt from to email selected ranges as a PDF file, but I get a compile error and the code below is highlighted

    Code:
     FileName = RDB_Create_PDF


    Your assistance in resolving this is most appreciated

    Code:
     Sub Mail_Report_PDF()
    
    Sheets(1).Select
    With Range("D:R,M:S,X:AJ,BA:BJ,BM:BR,BU:CH")
        .EntireColumn.Hidden = True
        End With
    
     Dim FileName As String
    
        If ActiveWindow.SelectedSheets.Count > 1 Then
            MsgBox "There is more then one sheet selected," & vbNewLine & _
                   "ungroup the sheets and try the macro again"
        Else
            'Call the function with the correct arguments
            'For a fixed range use this line
            FileName = RDB_Create_PDF(Source:=Range("Man_Report1", "MAN_Report2"), _
                                      FixedFilePathName:="", _
                                      OverwriteIfFileExist:=True, _
                                      OpenPDFAfterPublish:=False)
    
            'For the selection use Selection in the Source argument
            'FileName = RDB_Create_PDF(Source:=Selection)
    
            'For a fixed file name use this in the FixedFilePathName argument
            'FixedFilePathName:="C:\Users\Ron\Test\YourPdfFile.pdf"
    
            If FileName <> "" Then
                RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
                                     StrTo:="Mark@davidsonsn@Gm,ail.com", _
                                     StrCC:="", _
                                     StrBCC:="", _
                                     StrSubject:="Management Reports", _
                                     Signature:=True, _
                                     Send:=False, _
                                     StrBody:="Dear Sirs l" & _
                                              "See Attached Management Reports in PDF." & _
                                              "" & "Regards"
            Else
                MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                       "Microsoft Add-in is not installed" & vbNewLine & _
                       "You Canceled the GetSaveAsFilename dialog" & 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
    End Sub

    I have also posted on MrExcel.com

    http://www.mrexcel.com/forum/excel-q...-file-pdf.html

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,629
    Thanks
    114
    Thanked 644 Times in 588 Posts
    Howard,

    In this code, the line in question calls a function that Ron De Bruin wrote. You need to include that function in your project. Below is the function that you need:

    In a standard module
    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
    
        'Test If the Microsoft 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
                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
    
            '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
    
            'If Publish is Ok the function will return the file name
            If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
        End If
    End Function
    You are going to run into the same issue again when your code attempts to execute the line:

    RDB_Mail_PDF_Outlook FileNamePDF:=FileName, .....

    Here is the function that the above line calls.

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

  3. #3
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi Maud

    Thanks for pointing this out. I have managed now to covert the ranges to PDF and to email this

    See my code below

    I would like both PDF files (two separate ranges), attached to the same email and the file name to save these whatever name is in the Range for eg FileName = RDB_Create_PDF(Source:=Range("Man_Report1") Name in this instance must be saved as Man_Report1 and second file saved as MAN report2 as FileName = RDB_Create_PDF(Source:=Range("MAN report2")


    Your assistance in resolving this is most appreciated




    Code:
     Sub Mail_Report_PDF()
    
    Sheets(1).Select
    With Range("D:R,X:AJ")
        .EntireColumn.Hidden = True
        End With
    
     Dim FileName As String
    
        If ActiveWindow.SelectedSheets.Count > 1 Then
            MsgBox "There is more then one sheet selected," & vbNewLine & _
                   "ungroup the sheets and try the macro again"
        Else
            'Call the function with the correct arguments
            'For a fixed range use this line
            FileName = RDB_Create_PDF(Source:=Range("Man_Report1"), _
                                      FixedFilePathName:="", _
                                      OverwriteIfFileExist:=True, _
                                      OpenPDFAfterPublish:=False)
    
            'For the selection use Selection in the Source argument
            'FileName = RDB_Create_PDF(Source:=Selection)
    
            'For a fixed file name use this in the FixedFilePathName argument
            'FixedFilePathName:="C:\Users\Ron\Test\YourPdfFile.pdf"
    
            If FileName <> "" Then
                RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
                                     StrTo:="peter.xxxx@gmail.com", _
                                     StrCC:="", _
                                     StrBCC:="", _
                                     StrSubject:="Management accounts", _
                                     Signature:=True, _
                                     Send:=False, _
                                     StrBody:="<H3><B>Dear Peterl</B></H3><br>" & _
                                              "<body>See Attached Management accounts in PDF." & _
                                              "<br><br>" & "Regards</body>"
            Else
                MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                       "Microsoft Add-in is not installed" & vbNewLine & _
                       "You Canceled the GetSaveAsFilename dialog" & 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
        With Range("D:R,X:AJ")
        .EntireColumn.Hidden = False
        End With
        
        Sheets(1).Select
    With Range("D:R,X:AJ,BA:BJ,BM:BR,BU:CH")
        .EntireColumn.Hidden = True
        End With
    
     
    
        If ActiveWindow.SelectedSheets.Count > 1 Then
            MsgBox "There is more then one sheet selected," & vbNewLine & _
                   "ungroup the sheets and try the macro again"
        Else
            'Call the function with the correct arguments
            'For a fixed range use this line
            FileName = RDB_Create_PDF(Source:=Range("MAN report2"), _
                                      FixedFilePathName:="", _
                                      OverwriteIfFileExist:=True, _
                                      OpenPDFAfterPublish:=False)
    
            'For the selection use Selection in the Source argument
            'FileName = RDB_Create_PDF(Source:=Selection)
    
            'For a fixed file name use this in the FixedFilePathName argument
            'FixedFilePathName:="C:\Users\Ron\Test\YourPdfFile.pdf"
    
            If FileName <> "" Then
                RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
                                     StrTo:="peter.xxxx@gmail.com", _
                                     StrCC:="", _
                                     StrBCC:="", _
                                     StrSubject:="Management accounts", _
                                     Signature:=True, _
                                     Send:=False, _
                                     StrBody:="<H3><B>Dear Peter</B></H3><br>" & _
                                              "<body>See Attached Management accounts in PDF." & _
                                              "<br><br>" & "Regards</body>"
            Else
                MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                       "Microsoft Add-in is not installed" & vbNewLine & _
                       "You Canceled the GetSaveAsFilename dialog" & 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
        With Range("D:R,X:AJ,BA:BJ,BM:BR,BU:CH")
        .EntireColumn.Hidden = False
        End With
        
        
        
        
        
        
        
      
        
    End Sub
    
    
    Function RDB_Create_PDF(Source As Object, FixedFilePathName As String, _
                            OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
                           Sheets(1).Select
        Dim FileFormatstr As String
        Dim Fname As Variant
    
        'Test If the Microsoft 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
                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
    
            '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
    
            'If Publish is Ok the function will 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, _
                                  StrCC As String, StrBCC As String, StrSubject As String, _
                                  Signature As Boolean, Send As Boolean, StrBody As String)
                              Sheets(1).Select
        Dim OutApp As Object
        Dim OutMail As Object
    
        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

  4. #4
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi Maud

    I managed to sort out the automatic saving of the file

    I went through the code and amended

    Code:
     FixedFilePathName:="", _
       to 
    
    FixedFilePathName:="C:\users\my documents\Man Report1.pdf", _

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •