Save Workbook File With The Next Incrementing Version Number Index

**k0st4din** · 07-12-2013, 03:18 PM

Hello everyone.
I would like to ask you if you could tell me what put in my macro to do the following:
I have a workbook named "Ivan Ivanov" - as I pressed the button the macro to save in the same folder, but with a 1 next to the name (Ivan Ivanov 1). Ie every time you open the workbook "Ivan Ivanov" and give him a save to continue with one number up -> (Ivan Ivanov 2) (Ivan Ivanov 3), (Ivan Ivanov 4), and so each time.
Thanks in advance

**patel** · 07-12-2013, 11:21 PM

Code:

Sub saveProgressiveNumber()
Dim fs, snum As String
Set fs = CreateObject("Scripting.FileSystemObject")
Fname = " Ivan Ivanov "
fpath = "your path"
If Dir(fpath & "*.xls*") = "" Then
  ThisWorkbook.SaveAs (fpath & Fname & "0001.xlsm")
Else
  Set f = fs.GetFolder(fpath)
  Set NFile = f.Files
  For Each pf1 In f.Files
    date3 = pf1.DateLastModified
    Fname1 = pf1.Name
    If MDataUM < date3 Then
      FpathName = pf1
      MDataUM = date3
      fnameExt = Fname1
    End If
  Next
  fnum = Val(Mid(FpathName, InStr(FpathName, "-") + 1, 4)) + 1
  snum = Format(fnum, "0000")
  ThisWorkbook.SaveAs (fpath & Fname & snum & ".xlsm")
End If
End Sub

**Admin** · 07-12-2013, 11:25 PM

Hi

Not sure about this. BACKUP your original file before trying this solution.

Put this code in the workbook module.

Code:

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    
    Dim NewName     As String
    Dim iNum        As Long
    Dim OldName     As String
    Dim FileF       As Long
    Dim FileNm      As String
    
    Const FName     As String = "Ivan Ivanov"
    
    With ThisWorkbook
        OldName = .FullName
        FileF = .FileFormat
        FileNm = Left$(.Name, InStrRev(.Name, ".") - 1)
        iNum = Mid(FileNm, Len(FName) + 1)
        NewName = .Path & Application.PathSeparator & FName & iNum + 1 & ".xlsm"
        Application.DisplayAlerts = False
        Application.EnableEvents = False
        .ChangeFileAccess xlReadOnly
        FileCopy OldName, NewName
    End With
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Kill OldName 'comment this line if you want to keep the old file
    ThisWorkbook.Close 0
End Sub

**k0st4din** · 07-14-2013, 03:20 AM

Hello friends, thank you very much, but something happened to me things.
patel - your code is great, but these quotes for the path to the folder I received, ie "your path" replace it with "C:\xxxxx\xxxxxx\my folder name\" but always sends me the new file "ivan Ivanov 0001 "in My Documents, and not where I asked him the way. Where is the mistake?
Admin - want to keep the old (original file) and gives me an error in the code.
Ie it can explain a little more - on my desktop I have a folder and it is this excel file "Ivan Ivanov" when I open start to write things in the tables and then press the button makes another file duplicate of the first but with 1 (ivan Ivanov 1), and so with each successive number 1 above.

**patel** · 07-14-2013, 12:15 PM

Code:

Fname = "Ivan Ivanov " '--------- without initial space
fpath = "your path\"

**Admin** · 07-14-2013, 12:19 PM

Admin - want to keep the old (original file)

comment the line starts with Kill

**k0st4din** · 07-14-2013, 01:22 PM

patel - that pictures what is happening and he did not want to work on reaching the "save".

Screen_03 Jul. 14 11.05.jpg

Screen_02 Jul. 14 11.05.jpg

Admin - I do not know what it is asking, but put it this way: - Write in "Ivan Ivanov" save the new file "Ivan Ivanov 1" and the original "Ivan Ivanov" keeps writing until (the latter written in this excel file)

**patel** · 07-14-2013, 04:50 PM

Code:

Sub saveProgressiveNumber()
Dim fs, snum As String
Set fs = CreateObject("Scripting.FileSystemObject")
Fname = "Ivan Ivanov-" ' the name must end with -
fpath = "your path\"
If Dir(fpath & "*.xls*") = "" Then
  ThisWorkbook.SaveAs (fpath & Fname & "0001.xlsm")
Else
  Set f = fs.GetFolder(fpath)
  Set NFile = f.Files
  For Each pf1 In f.Files
    date3 = pf1.DateLastModified
    Fname1 = pf1.Name
    If MDataUM < date3 Then
      FpathName = pf1
      MDataUM = date3
      fnameExt = Fname1
    End If
  Next
  fnum = Val(Mid(FpathName, InStr(FpathName, "-") + 1, 4)) + 1
  snum = Format(fnum, "0000")
  ThisWorkbook.SaveAs (fpath & Fname & snum & ".xlsm")
End If
End Sub

**patel** · 07-14-2013, 09:46 PM

another option

Code:

Sub saveProgressiveNumber1()
    Dim newFileName As String, strPath As String
    Dim strFileName As String, strExt As String
    strPath = "C:\Users\ivan\Desktop\" 'Change to suit
    strFileName = "Ivan Ivanov"
    strExt = ".xlsm" 'Change to suit
    newFileName = strFileName & "-" & GetNewSuffix(strPath, strFileName, strExt) & strExt
    ActiveWorkbook.SaveCopyAs strPath & newFileName
End Sub
 
Function GetNewSuffix(ByVal strPath As String, ByVal strName As String, ByVal strExt As String) As Integer
    Dim strFile As String, strSuffix As String, intMax As Integer
    strFile = Dir(strPath & "\" & strName & "*")
    Do While strFile <> ""
        strSuffix = Mid(strFile, Len(strName) + 2, Len(strFile) - Len(strName) - Len(strExt) - 1)
        If Mid(strFile, Len(strName) + 1, 1) = "-" And CSng(strSuffix) >= 0 And _
        InStr(1, strSuffix, ",") = 0 And InStr(1, strSuffix, ".") = 0 Then
            If CInt(strSuffix) >= intMax Then intMax = CInt(strSuffix)
        End If
        strFile = Dir
    Loop
    GetNewSuffix = intMax + 1
End Function

**k0st4din** · 07-15-2013, 12:52 AM

Something is wrong in the code at the picture that I attach opened for the second time the original file "Ivan Ivanov" and when I press tells me that there is already such a file, and if I want to replace it, but it should save it as "Ivan Ivanov-0002".
Ie my idea is every time I open the original file and pressed the button to save the same name but with a number up (one number up) -> Ivan Ivanov-0001, a second file to be - Ivan Ivanov-0002, a third - ivan Ivanov-0003 and so every time. Not like now to save on old Ivan Ivanov-0001.

Screen_05 Jul. 14 22.30.jpg

The second macro that offered me gives me an error like "mish mash" in this line:

Code:

 If Mid(strFile, Len(strName) + 1, 1) = "-" And CSng(strSuffix) >= 0 And _
        InStr(1, strSuffix, ",") = 0 And InStr(1, strSuffix, ".") = 0 Then

And another thing if the file is (.xls), then the code itself should only change this -> ".xlsm" on ".xls"

Thread: Save Workbook File With The Next Incrementing Version Number Index

Thread Tools

Search Thread

Display

Save Workbook File With The Next Incrementing Version Number Index

Similar Threads

Exporting A Worksheet To A CSV File / Save Workbook As CSV File

Pass Row and Column Number Index To Refer And Put Value To Cell Range

How To Save Macro To Personal Workbook

Copy Sheets To New Workbook And Save

Overwrite Currently Open Excel Workbook File With A New File

Bookmarks

Bookmarks

Posting Permissions