Hi rvessio,
It would have been nice if you'd said you needed to check before overwriting. Try this variation:
Code:
Sub SaveToPDF()
Dim StrPath As String, StrName As String, Result
With ActiveDocument
On Error GoTo Errhandler
StrPath = GetFolder & "\"
StrName = Split(.Name, ".")(0)
While Dir(StrPath & StrName & ".pdf") <> ""
Result = InputBox("WARNING - A file already exists with the name:" & vbCr & _
Split(.Name, ".")(0) & vbCr & _
"You may edit the filename or continue without editing." _
& vbCr & vbTab & vbTab & vbTab & "Proceed?", "File Exists", StrName)
If Result = vbCancel Then Exit Sub
If StrName = Result Then GoTo Overwrite
StrName = Result
Wend
Overwrite:
.ExportAsFixedFormat OutputFileName:=StrPath & StrName & ".pdf", _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
End With
Errhandler:
End Sub
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function