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
