Issue with Create and email PDF code

raeray38501

New Member
Joined
Nov 1, 2013
Messages
6
Hi I am using Ron De Buin's macro to create and email a PDF version of an excel workbook. It works fine on my computer but when others try to use it they get an error. The part that it errors on is:
Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _
OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String

If Dir(Environ("commonprogramfiles")

If there is a better way to do this I would greatly appreciate any help. Below is the whole macro.

Thanks,
Rachael


Code:
Option Explicit

'Note: The macro's in this module call the functions in the "FunctionsModule"
'Be sure that you also copy the code from this module if you want to use it in your own workbook.

Sub RDB_Worksheet_Or_Worksheets_To_PDF_And_Create_Mail()
    Dim FileName As String
    Dim Rws As Long, Rng As Range
    
    Rws = Cells(Rows.Count, "B").End(xlUp).Row
    Set Rng = Range(Cells(1, 1), Cells(Rws, 12))

    With ActiveSheet
       .PageSetup.PrintArea = Rng.Address
    End With
    
    If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "There is more then one sheet selected," & vbNewLine & _
               "be aware that every selected sheet will be published"
    End If
    'Call the function with the correct arguments
    'Tip: You can also use Sheets("Sheet3") instead of ActiveSheet in the code(sheet not have to be active then)
    FileName = RDB_Create_PDF(ActiveSheet, "", True, False)
    'For a fixed file name and overwrite it each time you run the macro use
    'RDB_Create_PDF(ActiveSheet, "C:\Users\Ron\Test\YourPdfFile.pdf", True, False)
    If FileName <> "" Then
        RDB_Mail_PDF_Outlook FileName, " ", "Open Issues Report", _
                             "Please see attached PDF file for updates" _
                           & vbNewLine & vbNewLine, False
    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 Sub
'The code below are used by the macros in the other two modules
'Do not change the code in the functions in this module
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 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
        Myvar.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                FileName:=Fname, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=True
        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, _
                              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 = ""
        .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
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Hi Rachael,

Here are some debugging steps to try to narrow down the problem.

From within the VB Editor, enter this expression in the Immediate Window (hit Ctrl-G to display if the Immediate Window isn't visible).

Code:
?Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL"

On my system that returns on the next line....
C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE15\EXP_PDF.DLL

Go check to see if the file name returned is found on at that location on their system.

If those users get only:
\Common Files\Microsoft Shared\OFFICE15\EXP_PDF.DLL

...then it means that the environmental isn't defined for "commonprogramfiles"

What error are those users receiving?
What version of Excel are they using?

It's surprising that they are getting an error, because that If-Then statement is testing for the existence of the file and even if it's not there, an error should not occur (the pdf just won't be made).
 
Upvote 0

Forum statistics

Threads
1,223,656
Messages
6,173,618
Members
452,525
Latest member
DPOLKADOT

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