"Saveas"... If file already exists, add a version number to the new one

[raphagcwill]

Hello guys,

Is there anybody out there who could help me to adjust the below a little bit?

I have multiple sheets on my workbook and my macro renames sheet 1 based on the values of some cells.
Then the file to be saved in the folder will have the same name as sheet 1

The name will not always be the same, but it might happens sometimes.
If it happens, I want the macro to add a version number to the file's name. A version number is necessary since I do not want to overwrite the old file.

I have found the perfect macro, but i have been struggling to get it to work flawlessly.
It is Worth saying that I VBA level is VERY basic.

From the beginning I had some simple saveas function

ActiveWorkbook.SaveAs "C:\Raphael\Raphael_" & Range("J2") & "_" & Range("L2").Value, 52, Password:="12345", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False

But after researching a lot i found the below macros that are supposed to be used together.
VBA Code To Save As A New Version If File Already Exists

Function FileExist(FilePath As String) As Boolean
'PURPOSE: Test to see if a file exists or not
'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault
'RESOURCE: http://www.rondebruin.nl/win/s9/win003.htm

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

Sub SaveNewVersion_Excel()
'PURPOSE: Save file, if already exists add a new version indicator to filename
'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault

Dim FolderPath As String
Dim myPath As String
Dim SaveName As String
Dim SaveExt As String
Dim VersionExt As String
Dim Saved As Boolean
Dim x As Long

TestStr = ""
Saved = False
x = 2

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

'Pull info about file
  On Error GoTo NotSavedYet
    myPath = ActiveWorkbook.FullName
    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
    
'Test to see if file name already exists
  If FileExist(FolderPath & SaveName & SaveExt) = False Then
    ActiveWorkbook.SaveAs FolderPath & SaveName & SaveExt
    Exit Sub
  End If
      
'Need a new version made
  Do While Saved = False
    If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) = False Then
      ActiveWorkbook.SaveAs FolderPath & SaveName & VersionExt & x & SaveExt
      Saved = True
    Else
      x = x + 1
    End If
  Loop

'New version saved
  MsgBox "New file version saved (version " & x & ")"

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

I have changed the "test file path" to

'Test File Path (ie "C:\Raphael

On the macro below, I have modified the myfilename and Folderpath on the code below, but I am not sure what to change on mypath and SaveExt.
What happen sometimes is that the file is saved with the right extension (xlsm), but when I the error "Excel cannot open.....because the file of file extension is not valid"
On the folder the size of the file is only 8kb, but it should be over 205kb

'Pull info about file
  On Error GoTo NotSavedYet
    myPath = ActiveWorkbook.FullName
    myFileName = "Raphael_" & Range("J2") & "_" & Range("L2")
    FolderPath = "C:\Raphael
    SaveExt = "." & Right(myPath, Len(myPath) - InStrRev(myPath, "."))
  On Error GoTo 0

Thanks in advance

 

[thraling]

I would keep it simple

Dim wb_this As Workbook
Set wb_this = Application.ThisWorkbook

stringname = "C:\Raphael\" & Filename & ".xlsm"
wb_this.SaveAs (stringname)

making in advance the calculations for how you want to call your Filename and the checks whether that name already exists

 

[raphagcwill]

Hi there,

yeah, i understand i am doind things the hard way.
Actually I would be very happy If I only had a saveas function + the option to rename the file if is already exists.

I have tried asking for help, but no luck yet
http://www.mrexcel.com/forum/excel-...cation-do-you-want-replace-yes-no-cancel.html

I would keep it simple

Dim wb_this As Workbook
Set wb_this = Application.ThisWorkbook

stringname = "C:\Raphael\" & Filename & ".xlsm"
wb_this.SaveAs (stringname)

making in advance the calculations for how you want to call your Filename and the checks whether that name already exists

 

[thraling]

I mean, once you have your stringname (before the SaveAs) you can run your test macro, I imagine something like that

  On Error Resume Next
    TestStr = Dir(stringname)
  On Error GoTo 0

  If TestStr <> "" Then
    stringname="C:\Raphael\" & Filename & "V2.xlsm"
  End If

wb_this.SaveAs (stringname)

You can put a counter instead of V2 if you think you may have more than 2 versions.
The creation of the Filename basing on the cell value has to be done before that part.

Can this work?

 

[raphagcwill]

Hi again,

thank you for your time and effort.
I managed to get the more complicated macro to work without any glitch. I have changed it quite a lot

I will keep your suggestion just in case the other stopps working.

Have a nice day,

Regards,
Raphael

 

[Ona2021]

Hi again,

thank you for your time and effort.
I managed to get the more complicated macro to work without any glitch. I have changed it quite a lot

I will keep your suggestion just in case the other stopps working.

Have a nice day,

Regards,
Raphael

Hello

May you please share your adjusted code, I am trying to do the exact same thing.

 

[raphagcwill]

Hello!

It has been quite a while since this macro was modified and used.
I need to see if I still have it somewhere in my computer. The task was for a problem I was facing in my previous work.

I will keep you posted