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