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
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
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
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.
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHACode:Fname = "Ivan Ivanov " '--------- without initial space
fpath = "your path\"
https://www.youtube.com/watch?v=QjEWAJ3d-jw
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgwCGCesYkcmCcv7tzx4AaABAg
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgwCGCesYkcmCcv7tzx4AaABAg.9wbCfWMaaLa9wbLcU jbPCV 3
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgwCGCesYkcmCcv7tzx4AaABAg.9wbCfWMaaLa9wbLma sNyaX 1
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgzxkJD1jksXet8AZYB4AaABAg.9p3jaxCq0AG9wbF__ jtm9w 2
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxePNoJ9lMOZZIxSI54AaABAg.9n_K6OLzSGt9wbFsa Pa2ym 1
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgwUIM7LhCvJkBpHL4N4AaABAg.9j-vSfzAHrw9wbFzCwVRUo 1
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgwQ_hGXSa1PNKbT-r94AaABAg.9hmiz-Qc-bq9wbG1qa8wKO 1
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgwqWxGrYGjtUAJG6aF4AaABAg.9hI9sgAhykQ9wbG4K JfN91 1
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJL5BeSLbJ-m7BWW54AaABAg.9euWbYmFb169wbG8eMb5Wb 1
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgwaEHwTeazYGD7xHmN4AaABAg.9eWJC0jtPrJ9wbGCR m3IO6 1
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgySibJeWUXeEn3qez14AaABAg.9dj9CcZAzcq9wbGH5 FhlqO
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgyrMrxE5-AP81sgU8V4AaABAg.9aoKBx9yaE89wbGOGcNnKy 1
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=Ugw5b6kCEckEbGTccxp4AaABAg.9_Sbwexq-co9wbGW8LbhKp 1
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgyCQp_ShaVxQui5hJh4AaABAg.9ZBRfgBVmcd9wbGdP 0tnCi 2
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=Ugz_lKW2DNBax4Aemst4AaABAg.9Xjhb-fv4pt9wbGgysEibx
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxguKtw3d8jE8bkGTB4AaABAg.9UuGKC386629wbGl3 2wvjC 1
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgwLt2hK6AcHVnVlaUl4AaABAg.9HKd-ioHqxM9wbH2o6HYsJ 1
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=Ugw-IPT7RwxyRo4cbqd4AaABAg.9GqtD5j30Wp9wbH6q7RTJa 1
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgzLnQG1_LQtmvLQoot4AaABAg.9FvawuMTb-k9wbHFrsug5Z 1
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=Ugys6Ur7BNsRFbH_f_B4AaABAg.9DhZy5EEpKY9wbHfy JkVMG 3
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wbILDvziWr 2
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgwgzeOLschepoIO3gx4AaABAg.97v7ND4_6p298-gyUz3MY7 2
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
comment the line starts with KillQuote:
Admin - want to keep the old (original file)
patel - that pictures what is happening and he did not want to work on reaching the "save".
Attachment 980
Attachment 981
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)
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
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
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. :)
Attachment 982
The second macro that offered me gives me an error like "mish mash" in this line:
And another thing if the file is (.xls), then the code itself should only change this -> ".xlsm" on ".xls"Code:If Mid(strFile, Len(strName) + 1, 1) = "-" And CSng(strSuffix) >= 0 And _
InStr(1, strSuffix, ",") = 0 And InStr(1, strSuffix, ".") = 0 Then