Incremental number for saved files

[mdmackillop]

I use the following code to add incremental numbers to saved files to avoid duplication/overwriting. As FileSearch is not supported in 2007, what is the most efficient way to do this?

[VBA]
'Check if the attachment name exists, if so, add an increment
Function DocSave(StrFolderPath As String, DocName As String, Ext As String) As String
Dim Ext As String, SaveName As String
Dim fs As FileSearch
Set fs = Application.FileSearch
With fs
.NewSearch
.LookIn = StrFolderPath
.SearchSubFolders = False
.Filename = DocName
.MatchTextExactly = False
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
DocSave = DocName & "-" & .FoundFiles.Count & Ext
Increment = True 'to show "Saved As" message
Else
DocSave = DocName & Ext
End If
End With
Set fs = Nothing
End Function

[/VBA]

[Charlize]

Most efficient I don't know, but it's doing something.[VBA]Sub testit()
Dim newname As String
newname = Charlizes_Dir("C:\Temp", "Data", ".Doc")
MsgBox newname
End Sub
Function Charlizes_Dir(StrFolderPath As String, DocName As String, Ext As String) As String
Dim myfilename As String
Dim mycount As Long
mycount = 1
myfilename = Dir(StrFolderPath & "\" & DocName & "*")
Do While myfilename <> vbNullString
mycount = mycount + 1
myfilename = Dir
Loop
Charlizes_Dir = DocName & "-" & mycount & Ext
End Function[/VBA]

[tstav]

Suppose the name I want to increment is "Data.xls" but there are also other files named e.g. "DataMining.xls". It seems Charlize's option would give "Data-2.xls" when it should be "Data-1.xls".

[vba]Sub CreateNewFileName()
'----------------------------------------------------
'This version builds a suffix always one greater than
'the already existing max suffix.
'If no suffix exists, then suffix=1
'----------------------------------------------------
Dim newFileName As String, strPath As String
Dim strFileName As String, strExt As String
strPath = "C:\VBA_tstav"
strFileName = "VBA_Forums"
strExt = ".xls"
newFileName = strFileName & "-" & GetNewSuffix(strPath, strFileName, strExt) & strExt
MsgBox newFileName
End Sub

Function GetNewSuffix(ByVal strPath As String, ByVal strName As String, ByVal strExt As String)
Dim strFile As String, strSuffix As String, intMax As Integer
On Error Resume Next
strFile = Dir(strPath & "\" & strName & "*")
Do While strFile <> ""
strSuffix = Mid(strFile, Len(strName) + 1, Len(strFile) - Len(strName) - Len(strExt))
If Len(strSuffix) > 0 Then 'strName has suffix
If Left(strSuffix, 1) = "-" And CInt(Right(strSuffix, Len(strSuffix) - 1)) >= 0 Then
If Err Then
'ignore this file (it starts with strName but the fullname is different)
Err.Clear
Else
If CInt(Right(strSuffix, Len(strSuffix) - 1)) >= intMax Then
intMax = CInt(Right(strSuffix, Len(strSuffix) - 1))
End If
End If
End If
End If
strFile = Dir
Loop
GetNewSuffix = intMax + 1
End Function[/vba]

[Charlize]

Aha, try this one.[VBA]Sub testit()
Dim newname As String
newname = Charlizes_Dir("C:\Temp", "Data", ".Doc")
MsgBox newname
End Sub
Function Charlizes_Dir(StrFolderPath As String, DocName As String, Ext As String) As String
Dim myfilename As String
Dim mycount As Long
mycount = 1
myfilename = Dir(StrFolderPath & "\" & DocName & "*")
Do While myfilename <> vbNullString
If Len(StrFolderPath & "\" & Left(myfilename, Len(myfilename) - 4)) = _
Len(StrFolderPath & "\" & DocName) Then
mycount = mycount + 1
End If
myfilename = Dir
Loop
Charlizes_Dir = DocName & "-" & mycount & Ext
End Function[/VBA]

[mdmackillop]

My names will be created by code. I agree Data and DataMining could both cause an increment. This is unlikely and in any case would not matter . I'm more concerned with overwriting than getting consecutive numbers.
On the other hand, I can see that numbering may be of use to others, so let's include it in the problem!

[Charlize]

[vba]Sub testit()
Dim newname As String
newname = Charlizes_Dir("C:\Temp", "Data", ".Doc")
MsgBox newname
End Sub
Function Charlizes_Dir(StrFolderPath As String, DocName As String, Ext As String) As String
Dim myfilename As String
Dim mycount As Long
mycount = 1
myfilename = Dir(StrFolderPath & "\" & DocName & "*")
Do While myfilename <> vbNullString
'if no - are used inside the filename you can use split
If Len(StrFolderPath & "\" & Split(myfilename, "-")(0)) = _
Len(StrFolderPath & "\" & DocName) Or _
Len(StrFolderPath & "\" & myfilename) = _
Len(StrFolderPath & "\" & DocName & Ext) Then
mycount = mycount + 1
End If
myfilename = Dir
Loop
If mycount > 1 Then
Charlizes_Dir = DocName & "-" & mycount & Ext
Else
Charlizes_Dir = DocName & Ext
End If
End Function[/vba]

[tstav]

Charlize, try it with the filenames
"Data.doc", "Data-2.doc", "Data-4.doc"
or "Data-2.doc", "Data-3.doc", "Data-4.doc"
or... (more possibilities)...
It would produce the name "Data-4.doc" and it would overwrite the already existing one.

What I mean to say is that we not only have to count the "matching" files, but also keep track of the max suffix in order to add one to it and eliminate any chance of overwriting (post #3).

[Charlize]

Charlize, try it with the filenames
"Data.doc", "Data-2.doc", "Data-4.doc"
or "Data-2.doc", "Data-3.doc", "Data-4.doc"
or... (more possibilities)...
It would produce the name "Data-4.doc" and it would overwrite the already existing one.

What I mean to say is that we not only have to count the "matching" files, but also keep track of the max suffix in order to add one to it and eliminate any chance of overwriting (post #3).

Probably. But I assume that when you use automatic saving, that wouldn't be the case, would it ?

If you save by using the function, it would give the first name data, the second would be data-2, even with datamining in the folder. So not data-3 but indeed data-2 when you save a data the second time. (post #6)

Charlize

ps.: Nevertheless, it's an interesting approach.

[mdmackillop]

I'll test them shortly
Thanks to both.

[Charlize]

I'll test them shortly
Thanks to both.

Your welcome. But one other glitch is the file extensions. For the new Office 2007 it's 4 characters. Maybe should I check on the extension length to ?

Charlize

[tstav]

But I assume that when you use automatic saving, that wouldn't be the case, would it ?

You're right Charlize. Automatic saving creates no problems in the beginning. But with time users tend to delete files. And they will. And then problems may come up.

Example 1 (I've seen it happen) is the one I mentioned earlier (post #7). They deleted "Data.doc" and "Data-1.doc" and were left with -2,-3,-4 on their disk. The program overwrote file "Data-4.doc".

Example 2 would be to delete all files but Data-4.doc. After that, the code would save as "Data-2.doc" which might create confusion as to which file was saved last, the -2.doc or the -4.doc?

That's why I always increment the suffix number to one greater than the maximum found on disk.

tstav

Edit: For the ext length see also Post #3, though I don't see any problems in your post #6 either.

[tstav]

This seems to be a bit "cleaner" I think.
[vba]Sub CreateNewFileName()
'----------------------------------------------------
'This version builds a suffix always one greater than
'the already existing max suffix.
'----------------------------------------------------
Dim newFileName As String, strPath As String
Dim strFileName As String, strExt As String
strPath = "C:\VBA_tstav"
strFileName = "Data"
strExt = ".xls"
newFileName = strFileName & "-" & GetNewSuffix(strPath, strFileName, strExt) & strExt
MsgBox newFileName
End Sub

Function GetNewSuffix(ByVal strPath As String, ByVal strName As String, ByVal strExt As String) as integer
Dim strFile As String
Dim intMax As Integer, intSuffix As Integer, i As Integer
On Error Resume Next
strFile = Dir(strPath & "\" & strName & "*")
Do While strFile <> ""
'Exclude the extension
strFile = Left(strFile, Len(strFile) - Len(strExt))
If Len(strFile) > Len(strName) Then
'Get location of "-"
i = InStrRev(strFile, "-")
'Get the suffix number
intSuffix = IIf(i > 0, CInt(Mid(strFile, i + 1)), 0)
If Err Then
Err.Clear
Else
'Update the Max suffix number
intMax = IIf(intSuffix >= intMax, intSuffix, intMax)
End If
End If
strFile = Dir
Loop
'This is the incremented suffix number
GetNewSuffix = intMax + 1
End Function
[/vba]

[Simon Lloyd]

Malcom i know you know (as you have proven) but i may be missing the point, you said...

I'm more concerned with overwriting than getting consecutive numbers.

i would have thought the simplest solution would be to save as:
[VBA]
ThisWorkbook.SaveAs (ThisWorkbook.Name & " " & Format(Now, "dd-mm-yy hh.mm.ss"))

[/VBA]never get an overwrite again unless you are saving more than one book a second!

[tstav]

Apologies.
My post #12 won't work correctly in rare occasions like if a file named "Data-Whatever-1.doc" exists (with two dashes), because it'll count it as a valid file.

I will have to stick to post #3.

[mdmackillop]

Hi Tstav,
Making this change and it seems perfect
[VBA]
strFile = Dir(strPath & "\" & strName & "-" & "*")
[/VBA]
and a slight adjustment to your calling sub for easier testing
[VBA]
Sub CreateNewFileName()
'----------------------------------------------------
'This version builds a suffix always one greater than
'the already existing max suffix.
'----------------------------------------------------
Dim newFileName As String, strPath As String
Dim strFileName As String, strExt As String
strPath = "C:\AAA"
strFileName = "Data-fil"
strExt = ".xls"
newFileName = strFileName & "-" & GetNewSuffix(strPath, strFileName, strExt) & strExt
ActiveWorkbook.SaveCopyAs newFileName
MsgBox newFileName
End Sub

[/VBA]

[mdmackillop]

Charlize,
Nearly there but not quite, and I hadn't thought of the deleted files scenario either.

Simon,
I considered the Time route but it gets clumsy IMO. I would cetainly use it for archiving, where the date is important, but not necessary for my purpose.

Tstav
I think this should go in as a KB item.

Thanks all
Malcolm

[Simon Lloyd]

Ok Malcolm, how about this one?
[VBA]
Dim myNum, wn As String
wn = ActiveWorkbook.Name
myNum = Val(Mid$(wn, InStrRev(wn, "-") + 1))
If myNum = Year(Date) Then
myNum = 1
Else
myNum = myNum + 1
End If
sPath = ThisWorkbook.Path
saveName = sPath & ThisWorkbook.Name & " " & Format((Now), "dd-mmm-yyyy") & " Rev." & myNum & ".xls"
ActiveWorkbook.SaveAs (saveName)
[/VBA]i use this to have sameday saved files but without the time, so i just get a version change!

[Zack Barresse]

Tstav
I think this should go in as a KB item.

I would have to agree here. I would also say it would be preferrable to take care of the multiple "-" characters first, but it is very nice as it stands.

[Zack Barresse]

I use the following code to add incremental numbers to saved files to avoid duplication/overwriting. As FileSearch is not supported in 2007, what is the most efficient way to do this?

Something like this I would say that a naming convention is the most important thing you could use. Doing so would allow you to loop through your files with either the FSO method or the Dir() method, basically the only two methods available (to answer your original question). I would think about looping through and parsing the values either into a range to sort with, or array. My 2 cents.

[tstav]

Good day everybody!
Sorry for the late answer, I had to go away.
Malcolm, thank you for proposing that the code should go in as a KB entry and Zack, thank you for agreeing.
Taking your suggestions and thoughts into consideration, I gave the code a revamp and included the following:
A. Include the "-" in the Dir() function.
B. More elaborate check of the validity of the suffix
1. to contain no alphanumeric characters
2. not to contain a decimal point
C. The fileName should not end with a "-" and have no extention (there could be a "Data-" file on disk, users are unpredictable).

Here's the new code for your suggestions and feed back. Thank you all.
[vba]Sub CreateNewFileName()
'----------------------------------------------------
'This version builds a suffix always one greater than
'the already existing max suffix.
'----------------------------------------------------
Dim newFileName As String, strPath As String
Dim strFileName As String, strExt As String
strPath = "C:\"
strFileName = "Data"
strExt = ".xls"
newFileName = strFileName & "-" & GetNewSuffix(strPath, strFileName, strExt) & strExt
ActiveWorkbook.SaveCopyAs newFileName
MsgBox 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
On Error Resume Next
strFile = Dir(strPath & "\" & strName & "-" & "*")
Do While strFile <> ""
strSuffix = Mid(strFile, Len(strName) + 2, Len(strFile) - Len(strName) - Len(strExt) - 1)
If Err Then
'This file ends with a "-" and has no extention => skip it
Err.Clear
Else
'In the next line, enter "." if the decimal point of your regional settings is ","
'or enter "," if the decimal point of your regional settings is "."
If Mid(strFile, Len(strName) + 1, 1) = "-" And CSng(strSuffix) >= 0 And InStr(1, strSuffix, ".") = 0 Then
If Err Then
Err.Clear 'This file has an invalid suffix => skip it
ElseIf CSng(strSuffix) > CInt(CSng(strSuffix)) Then 'Decimal point found in suffix => skip this file
Else
If CInt(strSuffix) >= intMax Then
intMax = CInt(strSuffix)
End If
End If
End If
End If
strFile = Dir
Loop
GetNewSuffix = intMax + 1
End Function
[/vba]