PDF to Email add-in

[christinefox]

Hello,

I am using Ron debruin's PDF to Email add-in and it has been working perfectly for the past few years, however as of today, i am receiving this error:

Not possible to create the PDF, Possible reasons:
Microsoft add in is not installed
you cancelled the getsaveasfilename dialog
the path the save the file in arg 2 is not correct
you didnt want to overwrite the existing pdf if it exist

I have downloaded the add-in again from Ron's site and it is showing up as ticked in excel add ins. I am using Office 2016 and MS Outlook 2016.

There was a windows update last Friday and I do not know if this has had anything to do with the issue but I am hoping you may be able to assist me as to how I can fix this please.

The code I am using is as follows:

EMAIL TO PDF

Sub RDB_Selection_Range_To_PDF_And_Create_Mail()    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:=IIf(Range("R73").Value = "0", Range("M14:T45"), Range("M14:T73")), _
                                  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:=ActiveSheet.Range("K2").Value, _
                                 StrCC:="", _
                                 StrBCC:="", _
                                 StrSubject:="Invoice - Gold Coast Storage Co", _
                                 Signature:=True, _
                                 Send:=False, _
                                 StrBody:="Hi 
" & _
                                          "******>I hope all is well with you. " & _
                                          "

" & "Please kindly find attached invoice for storage 

Have a great day! " & _
                                          "

" & "Cheers!

"
        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

MODULE 1

[COLOR=#333333]
[/COLOR]'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(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






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 & "
" & .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
    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


    'Test If the Microsoft Add-in is installed
    If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
         & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then


        '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 If
End Function

Thanking you in advance for your assistance.

Christine</namedrange></namedrange>