Microsoft Office Forums - View Single Post

BrianHoard · 06-08-2023, 06:34 PM

If I understand what you're trying to do, please give this a try. You'll need to change the file paths in these files to your paths. Notice how in the text file, the 2nd line has a 1. This will be read by the script, and from there increment by one each time the script is executed. Saving the current document as somefile0001.docx, somefile0002.docx, etc. To keep track of the incremented saves, the script will update the text file with the new number. So if you close the doc and come back to it another time, it will pick up with the last number recorded.
Hopefully this helps.
The text file---------------

Code:

C:\myDocs\wordsOfWisdon.docx
1

-----VBA code: (Be sure to change the paths to yours)

Code:

Sub SaveDocumentWithIncrementedSuffix()
    ' Specify the path to the text file containing the base path and file name
    Dim filePath As String
    filePath = "C:\Temp\worddocs.txt."
    
    ' Read the base path and file name from the text file
    Dim baseFilePath As String
    Dim fileNumber As Integer
    Open filePath For Input As #1
    Line Input #1, baseFilePath
    Line Input #1, fileNumberStr
    Close #1
    
    ' Convert the read value to an integer
    fileNumber = Val(fileNumberStr)
    
    ' Extract the existing file extension
    Dim fileExt As String
    fileExt = "." & Split(baseFilePath, ".")(UBound(Split(baseFilePath, ".")))
    
    ' Remove the existing file extension from the base file path
    baseFilePath = Left(baseFilePath, Len(baseFilePath) - Len(fileExt))
    
    ' Increment the file number
    fileNumber = fileNumber + 1
    
    ' Create the new file name with the incremented suffix and removed duplicate file extension
    Dim newFileName As String
    newFileName = baseFilePath & Format(fileNumber, "0000") & fileExt
    
    ' Save the current document to the new path
    ActiveDocument.SaveAs2 newFileName
    
    ' Update the text file with the incremented file number
    Open filePath For Output As #1
    Print #1, baseFilePath & fileExt
    Print #1, fileNumber
    Close #1
End Sub