Check if filename exists.

[Darrin Henshaw]

When I started learning VB about a year ago, I just jumped into it not
really taking the time to read up and learn on it, so my first programs
were shall we say, enough to get the job done. Now that I've taken the
time to learn what it is I was doing, I've realized I need to optimize
my programs.

One such program is this. The user has to input data into multiple
cells. When they are finished the workbook is saved with the contents of
one cell. The problem being is that it is possible in the run of a day
to have multiple files with the same name. My current way around this is
as so:

Dim MyFile, MyFile1, MyFile2, MyFile3, MyFile4, MyFile5
MyFile = Dir("P:\Folder\" & Worksheets
_("GEMFEDCCOrderForm").Range("F9").Value & ".xls")
MyFile1 = Dir("P:\Folder\" & Worksheets _
("GEMFEDCCOrderForm").Range("F9").Value & "-1.xls")
MyFile2 = Dir("P:\Folder\" & Worksheets
_("GEMFEDCCOrderForm").Range("F9").Value & "-2.xls")
MyFile3 = Dir("P:\Folder\" & Worksheets
_("GEMFEDCCOrderForm").Range("F9").Value & "-3.xls")
MyFile4 = Dir("P:\Folder\" & Worksheets
_("GEMFEDCCOrderForm").Range("F9").Value & "-4.xls")
MyFile5 = Dir("P:\Folder\" & Worksheets
_("GEMFEDCCOrderForm").Range("F9").Value & "-5.xls")

If MyFile4 = Worksheets("Sheet1").Range("F9").Value & _
"-4.xls" Then
ActiveWorkbook.SaveAs Filename:="P:\Folder\" & _
Worksheets("Sheet1").Range("F9").Value & "-5.xls"
ElseIf MyFile3 = Worksheets("Sheet1").Range("F9").Value _ & "-3.xls"
Then
ActiveWorkbook.SaveAs Filename:="P:\Folder\" & _
Worksheets("Sheet1").Range("F9").Value & "-4.xls"
ElseIf MyFile2 = Worksheets("Sheet1").Range("F9").Value _ & "-2.xls"
Then
ActiveWorkbook.SaveAs Filename:="P:\Folder\" & _
Worksheets("Sheet1").Range("F9").Value & "-3.xls"
ElseIf MyFile1 = Worksheets("Sheet1").Range("F9").Value _ & "-1.xls"
Then
ActiveWorkbook.SaveAs Filename:="P:\Folder\" & _
Worksheets("Sheet1").Range("F9").Value & "-2.xls"
ElseIf MyFile = Worksheets("Sheet1").Range("F9").Value _ & ".xls" Then
ActiveWorkbook.SaveAs Filename:="P:\Folder\" & _
Worksheets("Sheet1").Range("F9").Value & "-1.xls"
ElseIf MyFile = "" Then
ActiveWorkbook.SaveAs Filename:="P:\Folder\" & _
Worksheets("Sheet1").Range("F9").Value & ".xls"
End If

As you can see VB starts working down, and until it hits a file that
exists. If there is no file in the folder with a filename of cell F9,
then it saves the workbook as that value. And the rest of the ElseIf's
are ignored. If it does find a file that exists, then it works through
the rest of the ElseIf's and checks to see if a file exists names the
vaue of F9, and the "-1", etc.

As I said this method works, but it is definitely not the best way. I
figure I could do use a Loop to check through to see if the file exists,
but don't know how to start. Any ideas to point me in the right
direction? Thanks.

*** Sent via Developersdex http://www.developersdex.com ***

 

[Darrin Henshaw]

I should explain. The actual worksheet name is GEMFEDCCOrderForm,
however, I thought I changed them all when I pasted to make it easier to
read. I obviously messed up. So that does not cause a problem. Also word
wrap messed up my "_" characters.



*** Sent via Developersdex http://www.developersdex.com ***

 

[Jim Cone]

Darrin,

The following code keeps adding a numeric suffix to the name in "F9"
until a unique name is found. It was working with my folder/file names.
Hope It works for you. - Optimized??

'---------------------------------
Sub AreTheyThere()
'Jim Cone - San Francisco, USA - May 04, 2005
'Requires project reference to "Microsoft Scripting Runtime" (scrrun.dll)

Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.File
Dim lngSuffix As Long
Dim lngCount As Long
Dim lngN As Long
Dim strNewName As String
Dim strOldName As String
Dim strArray() As String
Const strExt As String = ".xls"

'Setup references and assign values to variables.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("P:\Folder")
lngCount = objFolder.Files.Count
lngSuffix = 0
lngN = 1

'Size the array to agree with number of files.
ReDim strArray(1 To lngCount)

'Load array with names of all files in folder.
For Each objFile In objFolder.Files
strArray(lngN) = objFile.Name
lngN = lngN + 1
Next 'objFile

strOldName = Worksheets("GEMFEDCCOrderForm").Range("F9").Text

'Add -1 to file name on each loop and checks the name against
'the file names in the array.
Do
For lngN = 1 To lngCount
strNewName = strOldName & lngSuffix
If strNewName & strExt = strArray(lngN) Then
lngSuffix = lngSuffix - 1
'The Do loop will force the For Next loop to repeat.
Exit For
End If
Next 'lngN
'If no match found then you have a valid file name.
If lngN > lngCount Then Exit Do
Loop

MsgBox strNewName 'For testing only

Set objFile = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
End Sub
'------------------------------

 

[Jim Cone]

Darrin,

On the other hand, if you just want to clean up and
simply your code then see the following...
'-------------------------------------------------
Sub SimplifiedCode()
'Jim Cone - San Francisco, USA - May 05, 2005

Dim MyFile As String
Dim MyFile1 As String
Dim MyFile2 As String
Dim MyFile3 As String
Dim MyFile4 As String
Dim MyFile5 As String

With "P:\Folder\" & Worksheets("GEMFEDCCOrderForm").Range("F9")
MyFile = Dir(.Value & ".xls")
MyFile1 = Dir(.Value & "-1.xls")
MyFile2 = Dir(.Value & "-2.xls")
MyFile3 = Dir(.Value & "-3.xls")
MyFile4 = Dir(.Value & "-4.xls")
MyFile5 = Dir(.Value & "-5.xls")
End With

With Worksheets("Sheet1").Range("F9")
If MyFile4 = .Value & "-4.xls" Then
ActiveWorkbook.SaveAs Filename:="P:\Folder\" & .Value & "-5.xls"
ElseIf MyFile3 = .Value & "-3.xls" Then
ActiveWorkbook.SaveAs Filename:="P:\Folder\" & .Value & "-4.xls"
ElseIf MyFile2 = .Value & "-2.xls" Then
ActiveWorkbook.SaveAs Filename:="P:\Folder\" & .Value & "-3.xls"
ElseIf MyFile1 = .Value & "-1.xls" Then
ActiveWorkbook.SaveAs Filename:="P:\Folder\" & .Value & "-2.xls"
ElseIf MyFile = .Value & ".xls" Then
ActiveWorkbook.SaveAs Filename:="P:\Folder\" & .Value & "-1.xls"
ElseIf MyFile = "" Then
ActiveWorkbook.SaveAs Filename:="P:\Folder\" & .Value & ".xls"
End If
End With
End Sub
'----------------------------------------

Darrin,

The following code keeps adding a numeric suffix to the name in "F9"
until a unique name is found. It was working with my folder/file names.
Hope It works for you. - Optimized??

'---------------------------------
Sub AreTheyThere()
'Jim Cone - San Francisco, USA - May 04, 2005
'Requires project reference to "Microsoft Scripting Runtime" (scrrun.dll)
Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.File
Dim lngSuffix As Long
Dim lngCount As Long
Dim lngN As Long
Dim strNewName As String
Dim strOldName As String
Dim strArray() As String
Const strExt As String = ".xls"

 

[Dave Peterson]

Did this work for you:
With "P:\Folder\" & Worksheets("GEMFEDCCOrderForm").Range("F9")

 

[Dave Peterson]

I had trouble seeing what you were doing. Jim's code helped understand.

If I got it right...

You save the first version as book.xls, then book-1.xls, then book-2.xls just
looking for the next available number that isn't used. If that's correct, maybe
something like:

Option Explicit
Sub testme02()
Dim iCtr As Long
Dim testStr As String
Dim myFileName As String
Dim mySfx As String
Dim myFolder As String

myFolder = "P:\Folder\"

testStr = ""
On Error Resume Next
testStr = Dir(myFolder & "nul")
On Error GoTo 0
If testStr = "" Then
MsgBox "Design error--invalid drive/folder!"
Exit Sub
End If

myFileName = Worksheets("GEMFEDCCOrderForm").Range("F9").Value

iCtr = 0
Do
If iCtr = 0 Then
mySfx = ".xls"
Else
mySfx = "-" & iCtr & ".xls"
End If

If Dir(myFolder & myFileName & mySfx) = "" Then
'it ain't there, we can use that name!
Exit Do
Else
iCtr = iCtr + 1
End If
Loop

ActiveWorkbook.SaveAs Filename:=myFolder & myFileName & mySfx

MsgBox "File was saved as: " & myFolder & myFileName & mySfx

End Sub

 

[Jim Cone]

Hi Dave,

Good question. It compiled, however I didn't try to run it (I should have).
The following variation however will run...

Dim strValue As String
strValue = "P:\Folder\" & Worksheets("GEMFEDCCOrderForm").Range("F9").Value
MyFile = Dir(strValue & ".xls")
' more similar stuff...

Thank for pointing that out.

Jim Cone
San Francisco, USA

Did this work for you:
With "P:\Folder\" & Worksheets("GEMFEDCCOrderForm").Range("F9")

Jim Cone wrote:

-snip-