Not able to save PDFs from Excel/VBA on one computer - vba

Question

I recently received help here for an Excel spreadsheet we have that allows users to create quotations for customers. The spreadsheet uses VBA to allow the user to press a button which generates a PDF out from certain sheets, and attaches them to a new Outlook email.
Unfortunately this isn't working on one of the user's computers. The problem seems to be with the generating of the PDF. Initially when pressing the button, nothing happened. I suspected it was to do with the Microsoft Add-in to Save as PDF, so I made sure it was installed, which it was. After 'commenting out' the error message coming from the code to get to the real error message from Visual Basic, I found it to be this:
run-time error '-2147467261 (80004003)': Document not saved.
When clicking 'Debug' it highlights:
FileName = Create_PDF_Sheet_Level_Names(NamedRange:="addtopdf1", _
FixedFilePathName:=ThisWorkbook.Path & "\" & "Quotation - " & Range("G18") & ".pdf", _
OverwriteIfFileExist:=True, _
OpenPDFAfterPublish:=False)
Which relates to:
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
I'm really scratching my head here! Checked all settings side-by-side with my machine on Excel and Outlook, including Trust Centre settings. Also checked add-ins.

Answer 1

Please check if there is enough disk space where the user wants to save the PDF file to!
I would recommend to check the length of the PDF fullname (path, filename and file extension; in your example it is the variable "Fname") as well before calling "ActiveSheet.ExportAsFixedFormat(...)", because filenames (or rather fullnames) under Microsoft Windows regularly cannot exceed more than 255 characters (see: Naming Files, Paths, and Namespaces).