![]() |
#4
|
||||
|
||||
![]()
No, it will overwrite the existing file. If you want a prompt you will need extra code and you will have to determine what to do in that eventuality. My recommendation is to append a number to the file name, which is what the following will do:
Code:
Sub Macro1() Dim strPath As String Dim strDocname As String Dim lngAsk As Long strPath = "C:\Path\" strDocname = "MyPDF.pdf" If FileExists(strPath & strDocname) Then lngAsk = MsgBox(strPath & strDocname & " already exists. Do you wish to overwrite the file?", vbYesNo) If Not lngAsk = vbYes Then strDocname = strPath & FileNameUnique(strPath, strDocname, "pdf") Else strDocname = strPath & strDocname End If Else strDocname = strPath & strDocname End If 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 End Sub Public Function FileNameUnique(strPath As String, _ strFileName As String, _ strExtension As String) As String 'Graham Mayor - http://www.gmayor.com 'Requires the use of the FileExists function '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 lngF As Long Dim lngName As Long strExtension = Replace(strExtension, Chr(46), "") lngF = 1 lngName = Len(strFileName) - (Len(strExtension) + 1) strFileName = Left(strFileName, lngName) 'If the filename exists, add or increment a number to the filename 'and keep checking until a unique name is found Do While FileExists(strPath & strFileName & Chr(46) & strExtension) = True strFileName = Left(strFileName, lngName) & "(" & lngF & ")" lngF = lngF + 1 Loop 'Reassemble the filename FileNameUnique = strFileName & Chr(46) & strExtension lbl_Exit: Exit Function End Function Public Function FileExists(strFullName As String) As Boolean 'Graham Mayor - http://www.gmayor.com 'strFullName is the name with path of the file to check Dim FSO As Object Set FSO = CreateObject("Scripting.FileSystemObject") If FSO.FileExists(strFullName) Then FileExists = True Else FileExists = False End If lbl_Exit: Set FSO = Nothing Exit Function End Function
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
Thread Tools | |
Display Modes | |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Bookmarks | Schildkröte | Word VBA | 8 | 06-28-2015 11:13 AM |
![]() |
PeterPlys | Word VBA | 13 | 01-14-2015 06:41 AM |
Can't See Bookmarks | bobmayo | Word | 21 | 06-04-2013 07:37 AM |
![]() |
samanthab | Word | 3 | 01-19-2013 06:27 AM |
![]() |
Dom37 | Word VBA | 2 | 10-31-2011 03:28 AM |