SaveAs PDF problem

[JohnnyBravo]

I'm running Word 2016 version and I'm having an issue with a VBA routine I found on line. All i'm trying to do is to save as pdf. The routine works fine if the word doc is brand new and it hasn't been saving before. The routine checks to see if the document has been saved before, let's call it "Sales Proposal 1" and if it has, it prompts the user with 3 choices: "Sales 1 proposal" is already on your PC, do you wish to overwrite it? YES, NO, Cancel.

The error message is generated whenever I click on 'NO' it gives the following message:

invalid procedure call or argument
It's seems to be having an issue with the 'SaveAs2' part towards the bottom of the script below in the functions section. (The bold & underline is my emphasis only so you can spot it quicker).

Any assistance would be greatly appreciated. Thanks.

Here is the VBA routine:
=========================================================================== ================================

Sub Word_ExportPDF()
' PURPOSE: Generate A PDF Document From Current Word Document
' NOTES: PDF Will Be Saved To Same Folder As Word Document File
' SOURCE: www.TheSpreadsheetGuru.com/the-code-vault (http://www.TheSpreadsheetGuru.com/the-code-vault)
Dim CurrentFolder As String
Dim FileName As String
Dim myPath As String
Dim UniqueName As Boolean
UniqueName = False
' Store Information About Word File
myPath = ActiveDocument.FullName
CurrentFolder = ActiveDocument.Path & ""
FileName = Mid(myPath, InStrRev(myPath, "") + 1, _
InStrRev(myPath, ".") - InStrRev(myPath, "") - 1)
' Does File Already Exist?
Do While UniqueName = False
DirFile = CurrentFolder & FileName & ".pdf"
If Len(Dir(DirFile)) <> 0 Then
UserAnswer = MsgBox("Filename Already Exists! Click " & _
"[Yes] to override. Click [No] to Rename.", vbYesNoCancel).
If UserAnswer = vbYes Then
UniqueName = True
ElseIf UserAnswer = vbNo Then
Do
' Retrieve New File Name
FileName = InputBox("Provide New File Name " & _
"(will ask again if you provide an invalid file name)", _
"Enter File Name", FileName)
' Exit if User Wants To
If FileName = "False" Or FileName = "" Then Exit Sub
Loop While ValidFileName(FileName) = False
Else
Exit Sub 'Cancel
End If
Else
UniqueName = True
End If
Loop.
' Save As PDF Document
On Error GoTo ProblemSaving
ActiveDocument.ExportAsFixedFormat _
OutputFileName:=CurrentFolder & FileName & ".pdf", _
ExportFormat:=wdExportFormatPDF
On Error GoTo 0
' Confirm Save To User
With ActiveDocument
FolderName = Mid(.Path, InStrRev(.Path, "") + 1, Len(.Path) - InStrRev(.Path, ""))
End With
MsgBox "PDF has now been saved in the Folder: " & FolderName
Exit Sub
' Error Handlers
ProblemSaving:
MsgBox "There was a problem saving your PDF. This is most commonly caused" & by the original PDF file already being open."
Exit Sub
End Sub

Function ValidFileName(FileName As String) As Boolean
' PURPOSE: Determine If A Given Word Document File Name Is Valid
' SOURCE: www.TheSpreadsheetGuru.com/the-code-vault (http://www.TheSpreadsheetGuru.com/the-code-vault)
Dim TempPath As String
Dim doc As Document
' Determine Folder Where Temporary Files Are Stored
TempPath = Environ("TEMP")
' Create a Temporary XLS file (XLS in case there are macros)
On Error GoTo InvalidFileName
Set doc = ActiveDocument.SaveAs2(ActiveDocument.TempPath & "" & FileName & ".doc", wdFormatDocument)
On Error Resume Next
' Delete Temp File
Kill doc.FullName
' File Name is Valid
ValidFileName = True
Exit Function
' ERROR HANDLERS
InvalidFileName:
' File Name is Invalid
ValidFileName = False
End Function

[gmayor]

That code is frankly dreadful - even allowing for the several undeclared document variables, the syntax for the SaveAs2 routine is wrong. To save to PDF, use the following instead. There won't be any invalid characters because it uses the same name as the document. In the event the PDF name exists in the document folder, a number is appended to the filename e.g filename(1).pdf, filename(2).pdf etc., so no PDF files are overwritten.

Option Explicit

Sub SaveAsPDF()
' Graham Mayor - https://www.gmayor.com - Last updated - 04 Mar 2019
Dim strDocName As String
Dim strPath As String
Dim intPos As Integer
Start:
' Find position of extension in filename
strDocName = ActiveDocument.Name
strPath = ActiveDocument.path & "\"
intPos = InStrRev(strDocName, ".")
If intPos = 0 Then
ActiveDocument.Save
GoTo Start
End If
strDocName = Left(strDocName, intPos - 1)
strDocName = strPath & FileNameUnique(strPath, strDocName, ".pdf")
ActiveDocument.ExportAsFixedFormat OutputFileName:=strDocName, _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, from:=1, to:=1, _
Item:=wdExportDocumentContent, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=wdExportCreateHeadingBookmarks, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False
lbl_Exit:
Exit Sub
End Sub

Private Function FileNameUnique(strPath As String, _
strFileName As String, strExtension As String) As String
' Graham Mayor - http://www.gmayor.com - Last updated - 22 Jun 2018
' strPath is the path in which the file is to be saved
' strFilename is the filename to check
' strextension is the extension of the filename to check
Dim lng_F As Long
Dim lng_Name As Long
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
strExtension = Replace(strExtension, Chr(46), "")
lng_F = 1
lng_Name = Len(strFileName) - (Len(strExtension) + 1)
strFileName = Left(strFileName, lng_Name)
'If the filename exists, add or increment a number to the filename
'and keep checking until a unique name is found
Do While FSO.FileExists(strPath & strFileName & Chr(46) & strExtension) = True
strFileName = Left(strFileName, lng_Name) & "(" & lng_F & ")"
lng_F = lng_F + 1
Loop
' Reassemble the filename
FileNameUnique = strFileName & Chr(46) & strExtension
lbl_Exit:
Set FSO = Nothing
Exit Function
End Function

[Paul_Hossler]

@JohnnyBravo --

You have 172 posts so please remember to use the CODE tags icon.

We really do like to have the macros formatted and set off

I added them to your first post