Expert: David Barrett - 7/23/2008

Question
QUESTION: Help. I want to get my macro to check if a filename already exists, and if it does create next filename in a series.
E.g. if filename AKL200807-001.xls exists, then it would create AKL200807-002.xls
The first part of the filename "AKL200807-" is from a value in a cell, the 001 is the bit i'm having issues with...

I know probably I need to use and if/then, but not sure how to go about it... Any Suggestions

ANSWER: The code below demonstrates how you can achieve this.  Amend the commented lines as appropriate.



dim objFSO as object
dim i as integer
dim strFileNamePrefix as string
dim strPath as string
dim strUniqueFilename as string

strPath="d:\test\" ' This is the path to save your file - needs trailing /
strFileNamePrefix=Range("A1") ' This is your filename, e.g. "AKL200807-"
set objFSO=CreateObject("Scripting.FileSystemObject")
i=1
while objFSO.FileExists(strPath & strFileNamePrefix & Pad(i,3))
  i=i+1
Wend
set objFSO=Nothing
strUniqueFilename=strPath & strFileNamePrefix & Pad(i,3) ' This is your unique filename


function Pad(intNum as integer, intLen as integer)
  dim strX as string
  strX=CStr(intNum)
  Pad=Space(intLen-Len(strX)) & strX
end function

---------- FOLLOW-UP ----------

QUESTION: Hi
I put it in a empty workbook
Put "AKL200807-" in cell A1
Changed the "d:\test\" to "C:\Documents and Settings\nardines\My Documents\"

Looks like this;
Sub onemore()

Dim objFSO As Object
Dim i As Integer
Dim strFileNamePrefix As String
Dim strPath As String
Dim strUniqueFilename As String

strPath = "C:\Documents and Settings\nardines\My Documents\" ' This is the path to save your file - needs trailing /
strFileNamePrefix = Range("A1") ' This is your filename, e.g. "AKL200807-"
Set objFSO = CreateObject("Scripting.FileSystemObject")
i = 1
While objFSO.FileExists(strPath & strFileNamePrefix & Pad(i, 3))
 i = i + 1
Wend
Set objFSO = Nothing
strUniqueFilename = strPath & strFileNamePrefix & Pad(i, 3)

End Sub


Function Pad(intNum As Integer, intLen As Integer)
 Dim strX As String
 strX = CStr(intNum)
 Pad = Space(intLen - Len(strX)) & strX
End Function

But it doesn't seem to be doing anything...
I think i am missing some vital function!




ANSWER: Well, there was a small oversight on my part (forgot the .xls extension).  Additionally, the code as it was didn't do anything except find a unique filename (it was simply a demonstration of how to do this).  So even with the .xls you wouldn't have seen it do anything!

The code below will show a messagebox with the found filename.  If you uncomment the line marked, it will also save the activeworkbook using that filename.



Sub onemore()

Dim objFSO As Object
Dim i As Integer
Dim strFileNamePrefix As String
Dim strPath As String
Dim strUniqueFilename As String

strPath = "C:\Documents and Settings\nardines\My Documents\" ' This is the path to save your file - needs trailing /
strFileNamePrefix = Range("A1") ' This is your filename, e.g. "AKL200807-"
Set objFSO = CreateObject("Scripting.FileSystemObject")
i = 1
While objFSO.FileExists(strPath & strFileNamePrefix & Pad(i, 3) & ".xls")
i = i + 1
Wend
Set objFSO = Nothing
strUniqueFilename = strPath & strFileNamePrefix & Pad(i, 3) & ".xls"
MsgBox "Unique filename found as: " & strUniqueFilename
' Uncomment the next line to save the active workbook as the found filename
'Activeworkbook.SaveAs strUniqueFileName
End Sub


Function Pad(intNum As Integer, intLen As Integer)
Dim strX As String
strX = CStr(intNum)
Pad = Space(intLen - Len(strX)) & strX
End Function

---------- FOLLOW-UP ----------

QUESTION: OK One last thing
It works, but the filename is AKL200807-  1.xls
it has 2 spaces rather than leading zeros... e.g. AKL200807-001.xls


Answer
Sorry, my mistake. Below pads with zeros.



Sub onemore()

Dim objFSO As Object
Dim i As Integer
Dim strFileNamePrefix As String
Dim strPath As String
Dim strUniqueFilename As String

strPath = "C:\Documents and Settings\nardines\My Documents\" ' This is the path to save your file - needs trailing /
strFileNamePrefix = Range("A1") ' This is your filename, e.g. "AKL200807-"
Set objFSO = CreateObject("Scripting.FileSystemObject")
i = 1
While objFSO.FileExists(strPath & strFileNamePrefix & Pad(i, 3) & ".xls")
i = i + 1
Wend
Set objFSO = Nothing
strUniqueFilename = strPath & strFileNamePrefix & Pad(i, 3) & ".xls"
MsgBox "Unique filename found as: " & strUniqueFilename
' Uncomment the next line to save the active workbook as the found filename
'Activeworkbook.SaveAs strUniqueFileName
End Sub


Function Pad(intNum As Integer, intLen As Integer)
Dim strX As String
strX = CStr(intNum)
Pad = String(intLen - Len(strX),"0") & strX
End Function