Save and Rename File based on location

Question

I have working code to:

1. Insert the Date, Company Name & Order Number into the proof at a specific location (data is pulled from the file location "C:\2020\My Company\Company Name\COM001 - 01\Layouts")
2. Determine the amount of pages in the document
3. Paste step 1 onto the other pages
4. Export the document as a .pdf

What I am trying to achieve, is before the .pdf is saved that the file is renamed (in this case COM001 - 01) adds a version indicator (" _v1") then saves the .cdr file and then runs the .pdf export function but does not overwrite the original.

I have been trying to adapt code I found on thespreadsheetguru.

The code adds the version indicator and exports the .pdf in the correct file location, but as soon as I open another file in a different location it will save it in the previous location instead.

Here is that piece of code: (I can upload the entire code if needed.)

Private Sub SaveNewVersion()
    'PURPOSE: Save file, if already exists add a new version indicator to filename

    Dim FolderPath, myPath, SaveName, SaveExt, VersionExt As String
    Dim Saved As Boolean
    Dim x As Long
    Saved = False
    x = 1

    'Version Indicator (change to liking)
    VersionExt = " _v"

    'Pull info about file
    On Error GoTo NotSavedYet
    myPath = ActiveDocument.FileName
    myFileName = Mid(myPath, InStrRev(myPath, "\") + 1, InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1)
    FolderPath = Left(myPath, InStrRev(myPath, "\"))
    SaveExt = "." & Right(myPath, Len(myPath) - InStrRev(myPath, "."))
    On Error GoTo 0

    'Determine Base File Name
    If InStr(1, myFileName, VersionExt) > 1 Then
        myArray = Split(myFileName, VersionExt)
        SaveName = myArray(0)
    Else
        SaveName = myFileName
    End If

    'Need a new version made
    Do While Saved = False
        If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) = False Then
            ActiveDocument.SaveAs FolderPath & SaveName & VersionExt & x & SaveExt
            Saved = True
        Else
            x = x + 1
        End If
    Loop
    Exit Sub

'Error Handler
NotSavedYet:
    MsgBox "This file has not been initially saved. " & _
      "Cannot save a new version!", vbCritical, "Not Saved To Computer"
End Sub


Function FileExist(FilePath As String) As Boolean
    'PURPOSE: Test to see if a file exists or not
    Dim TestStr As String
    'Test File Path (ie "C:\Users\Chris\Desktop\Test\book1.xlsm")
    On Error Resume Next
    TestStr = Dir(FilePath)
    On Error GoTo 0

    'Determine if File exists
    If TestStr = "" Then
        FileExist = False
    Else
        FileExist = True
    End If
End Function 

I have a feeling the code is messing up in the "pull info about file section".

Answer 1

You need to store the final path in a way that you can inspect it before you use it. Swap out this block of code here:

Dim newFileName as String
newFileName = FolderPath & SaveName & VersionExt & x & SaveExt
Debug.Print newFileName 
If FileExist(newFileName) = False Then
    ActiveDocument.SaveAs newFileName 
    Saved = True
Else
    x = x + 1
End If

This will print the final filename to the Immediate Window before the save happens. If it is incorrect, change newFileName to be whatever you want.