PDA

View Full Version : Format Incremental Value as Two Digit String



t0mato
12-23-2021, 09:39 AM
Hello,

VBA newb here. I found some VBA online that saves a new file with an incremental value added to it. Please see code below:


Sub CreateNewFileName()'--------------------------------------------------------------------------------
'Produces an incremental FileName (if name is 'Data' it creates Data-1.xls)
'Builds a suffix always one greater than the max suffix of any other potentially
'existing files that have the same 'root' name, e.g. if 'Data.xls' and 'Data-2.xls'
'exist, it creates Data-3.xls
'Helps to avoid overwrite old files (among other uses)
'--------------------------------------------------------------------------------
Dim newFileName As String, strPath As String
Dim strFileName As String, strExt As String
strPath = "C:\AAA\" 'Change to suit
strFileName = "Data" 'Change to suit
strExt = ".xls" 'Change to suit
newFileName = strFileName & "-" & GetNewSuffix(strPath, strFileName, strExt) & strExt
MsgBox "The new FileName is: " & newFileName
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
On Error GoTo ErrorHandler
'File's name
strFile = Dir(strPath & "\" & strName & "*")
Do While strFile <> ""
'File's suffix starts 2 chars after 'root' name (right after the "-")
strSuffix = Mid(strFile, Len(strName) + 2, Len(strFile) - Len(strName) - Len(strExt) - 1)
'FileName is valid if 1st char after name is "-" and suffix is numeric with no dec point
'Skip file if "." or "," exists in suffix
If Mid(strFile, Len(strName) + 1, 1) = "-" And CSng(strSuffix) >= 0 And _
InStr(1, strSuffix, ",") = 0 And InStr(1, strSuffix, ".") = 0 Then
'Store the max suffix
If CInt(strSuffix) >= intMax Then intMax = CInt(strSuffix)
End If
NextFile:
strFile = Dir
Loop
GetNewSuffix = intMax + 1
Exit Function


ErrorHandler:
If Err Then
Err.Clear
Resume NextFile
End If
End Function

As a newb, I'm simply looking to change the file name to not output as, for example, "Data-1.xlsx", rather I'd like it as "01-Data.xlsx" and can't figure it out.

How do I make this small adjustment?

Thanks!

Dave
12-23-2021, 11:38 AM
newFileName = GetNewSuffix(strPath, strFileName, strExt) & "-" & strFileName & strExt
HTH. Dave

p45cal
12-23-2021, 12:19 PM
How do I make this small adjustment?
It's not especially small.
try:
Sub CreateNewFileName()
Dim newFileName As String, strPath As String
Dim strFileName As String, strExt As String
strPath = "C:\AAA\" 'Change to suit
strFileName = "-Data" 'Change to suit
strExt = ".xls" 'Change to suit
newFileName = GetNewSuffix(strPath, strFileName, strExt) & strFileName & strExt
MsgBox "The new FileName is: " & newFileName
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
On Error GoTo ErrorHandler
'File's name
strFile = Dir(strPath & "\*" & strName & strExt)
Do While strFile <> ""
strSuffix = Left(strFile, InStrRev(strFile, strName & strExt, , vbTextCompare) - 1)
'Skip file if "." or "," exists in suffix or it's not numeric:
If IsNumeric(strSuffix) And InStr(1, strSuffix, ",") = 0 And InStr(1, strSuffix, ".") = 0 Then
'Store the max suffix:
If CLng(strSuffix) >= intMax Then intMax = CLng(strSuffix)
End If
NextFile:
strFile = Dir
Loop
GetNewSuffix = intMax + 1
Exit Function


ErrorHandler:
If Err Then
Err.Clear
Resume NextFile
End If
End Function
Of course, perversely, everything that refers to suffix refers to prefix!

Dave
12-23-2021, 04:40 PM
:blush Whoops! Thanks p45cal. Have a Merry X-mas. Dave

t0mato
12-24-2021, 09:43 AM
It's not especially small.
try:
Sub CreateNewFileName()
Dim newFileName As String, strPath As String
Dim strFileName As String, strExt As String
strPath = "C:\AAA\" 'Change to suit
strFileName = "-Data" 'Change to suit
strExt = ".xls" 'Change to suit
newFileName = GetNewSuffix(strPath, strFileName, strExt) & strFileName & strExt
MsgBox "The new FileName is: " & newFileName
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
On Error GoTo ErrorHandler
'File's name
strFile = Dir(strPath & "\*" & strName & strExt)
Do While strFile <> ""
strSuffix = Left(strFile, InStrRev(strFile, strName & strExt, , vbTextCompare) - 1)
'Skip file if "." or "," exists in suffix or it's not numeric:
If IsNumeric(strSuffix) And InStr(1, strSuffix, ",") = 0 And InStr(1, strSuffix, ".") = 0 Then
'Store the max suffix:
If CLng(strSuffix) >= intMax Then intMax = CLng(strSuffix)
End If
NextFile:
strFile = Dir
Loop
GetNewSuffix = intMax + 1
Exit Function


ErrorHandler:
If Err Then
Err.Clear
Resume NextFile
End If
End Function
Of course, perversely, everything that refers to suffix refers to prefix!

Thanks for the response! This however does not seem to work. The newly created file is still titled "1-Data.xls". How can I make this a two digit number, e.g. "01-Data.xls"? Perhaps something along the lines of this may help: formattedIntAsString = Format(Cstr(intValue), "00")

p45cal
12-24-2021, 10:18 AM
Change the GetNewSuffix function to:
Function GetNewSuffix(ByVal strPath As String, ByVal strName As String, ByVal strExt As String) As String
Dim strFile As String, strSuffix As String, intMax As Long
On Error GoTo ErrorHandler
'File's name
strFile = Dir(strPath & "\*" & strName & strExt)
Do While strFile <> ""
strSuffix = Left(strFile, InStrRev(strFile, strName & strExt, , vbTextCompare) - 1)
'Skip file if "." or "," exists in suffix or it's not numeric:
If IsNumeric(strSuffix) And InStr(1, strSuffix, ",") = 0 And InStr(1, strSuffix, ".") = 0 Then
'Store the max suffix:
If CLng(strSuffix) >= intMax Then intMax = CLng(strSuffix)
End If
NextFile:
strFile = Dir
Loop
GetNewSuffix = Format(intMax + 1, "00")
Exit Function


ErrorHandler:
If Err Then
Err.Clear
Resume NextFile
End If
End Function

t0mato
12-24-2021, 10:55 AM
Change the GetNewSuffix function to:
Function GetNewSuffix(ByVal strPath As String, ByVal strName As String, ByVal strExt As String) As String
Dim strFile As String, strSuffix As String, intMax As Long
On Error GoTo ErrorHandler
'File's name
strFile = Dir(strPath & "\*" & strName & strExt)
Do While strFile <> ""
strSuffix = Left(strFile, InStrRev(strFile, strName & strExt, , vbTextCompare) - 1)
'Skip file if "." or "," exists in suffix or it's not numeric:
If IsNumeric(strSuffix) And InStr(1, strSuffix, ",") = 0 And InStr(1, strSuffix, ".") = 0 Then
'Store the max suffix:
If CLng(strSuffix) >= intMax Then intMax = CLng(strSuffix)
End If
NextFile:
strFile = Dir
Loop
GetNewSuffix = Format(intMax + 1, "00")
Exit Function


ErrorHandler:
If Err Then
Err.Clear
Resume NextFile
End If
End Function


This works perfect, thank you! My only question now is that I don't think this is incrementing the value now that it is Long rather than integer. There is a line in the code that reads "'Skip file if "." or "," exists in suffix or it's not numeric:". The suffix I don't believe is numeric anymore and thus it wont increment the file name (01, 02, 03), rather it just keeps creating a new file with the 01 suffix (prefix). How would we adjust this so that it continues to increment?

snb
12-25-2021, 10:31 AM
Sub M_snb()
With thisworkbook
.saveas .path & replace(.name,val(.name),format(val(.name)+1,"00"))
end with
End Sub

p45cal
12-26-2021, 04:13 AM
This works perfect, thank you! My only question now is that I don't think this is incrementing the value now that it is Long rather than integer.
Nonsense. Int and Lng are both whole numbers.



There is a line in the code that reads "'Skip file if "." or "," exists in suffix or it's not numeric:". The suffix I don't believe is numeric anymore and thus it wont increment the file name (01, 02, 03), rather it just keeps creating a new file with the 01 suffix (prefix). How would we adjust this so that it continues to increment?
This is what I get:
29255

The variable strSuffix is a string. The IsNumeric tests a string to see if it is compatible with being a number (it would be pointless asking if a numeric variable is numeric because the answer would always be true).

Originally the GetNewSuffix function returned an integer, I changed it to a string because you wanted if formatted 01,02 etc. and you won't find anywhere in Excel where a number is stored with a leading zero.

For the avoidance of doubt, you should be using the CreateNewFilename from mag#3 with GetNewSuffix from msg#6:
Sub CreateNewFileName()
Dim newFileName As String, strPath As String
Dim strFileName As String, strExt As String
strPath = "C:\AAA\" 'Change to suit
strFileName = "-Data" 'Change to suit
strExt = ".xls" 'Change to suit
newFileName = GetNewSuffix(strPath, strFileName, strExt) & strFileName & strExt
MsgBox "The new FileName is: " & newFileName
ActiveWorkbook.SaveCopyAs strPath & newFileName
End Sub


Function GetNewSuffix(ByVal strPath As String, ByVal strName As String, ByVal strExt As String) As String
Dim strFile As String, strSuffix As String, intMax As Long
On Error GoTo ErrorHandler
'File's name
strFile = Dir(strPath & "\*" & strName & strExt)
Do While strFile <> ""
strSuffix = Left(strFile, InStrRev(strFile, strName & strExt, , vbTextCompare) - 1)
'Skip file if "." or "," exists in suffix or it's not numeric:
If IsNumeric(strSuffix) And InStr(1, strSuffix, ",") = 0 And InStr(1, strSuffix, ".") = 0 Then
'Store the max suffix:
If CLng(strSuffix) >= intMax Then intMax = CLng(strSuffix)
End If
NextFile:
strFile = Dir
Loop
GetNewSuffix = Format(intMax + 1, "00")
Exit Function


ErrorHandler:
If Err Then
Err.Clear
Resume NextFile
End If
End Function