Multiple folder search for file name

[mgiehm]

I have a macro I have been building for a while and ran into another snag. The macro creates its own file name in a specified directory based upon a cell. If that name exists it adds a -1 -2 etc. Problem is that I need it to search 4 folders for the file name and know what the next file number should be. Here is the code for the page that I'm using.

Sub SaveSheet()
 



With ActiveWorkbook.BuiltinDocumentProperties
.Item("Title") = Sheets("Steel Shop").Range("C2").Value
.Item("Subject") = Sheets("Steel Shop").Range("N8").Value
.Item("Author") = Sheets("Steel Shop").Range("C8").Value

End With




Dim currentDefaultFilePath As String

currentDefaultFilePath = Application.DefaultFilePath

Application.DefaultFilePath = "\\PC-1\Inbox\"
'error trap
On Error GoTo Etrap

Call nameChng
Call drwing
Dim MyCell
MyCell = Sheets("Steel Shop").Range("C5").Value

'ask user to save

If MsgBox("Save new workbook as " & MyCell & ".xls?", vbYesNo) = vbNo Then
Exit Sub
End If

'check value of activecell
If MyCell = "" Then
MsgBox "Please check the Job #", vbInformation
Exit Sub
End If



'save activeworkbook as new workbook
ActiveSheet.Shapes("CommandButton1").Visible = True
ActiveSheet.Shapes("NetCardSave").Delete

ActiveSheet.Shapes("CommandButton4").Visible = True

ActiveSheet.Shapes("CommandButton5").Visible = False


Call Sent

Call Pwords


Dim i As Integer
Dim sFileName As String
i = 1
sFileName = MyCell & "-" & i & ".xls"


Do
If Dir(sFileName) <> "" Then
i = i + 1
Let sFileName = "\\PC-1\Inbox\" & MyCell & "-" & i & ".xls"
Else
End If
Loop Until Dir(sFileName) = ""
ActiveWorkbook.SaveAs sFileName, _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False


Dim wbMyWB As Workbook
Dim sXLSName As String
Dim sCSVName As String

  Set wbMyWB = ActiveWorkbook
  sXLSName = wbMyWB.Name
  sCSVName = ActiveWorkbook.Name

  Workbooks.Open "\\PC-1\Inbox\Steel Shop Card.xltm"
  Workbooks(sCSVName).Close
Exit Sub


Etrap:
Application.DefaultFilePath = currentDefaultFilePath
Beep



Exit Sub

End Sub

This is the code that saves the file after searching the current directory for the file name.

Dim i As Integer
Dim sFileName As String
i = 1
sFileName = MyCell & "-" & i & ".xls"


Do
If Dir(sFileName) <> "" Then
i = i + 1
Let sFileName = "\\PC-1\Inbox\" & MyCell & "-" & i & ".xls"
Else
End If
Loop Until Dir(sFileName) = ""
ActiveWorkbook.SaveAs sFileName, _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False

I'm sure my codes don't follow the rules they should but they do work. After all I'm a salesman not a programmer. LOL Thanks for all your help!!

 

[mgiehm]

Well, since no body has replied let me see if I can describe what I'm trying to get the program to do a little better.

The user will press a button, the document will save with the value in cell C5 as the file name with a -1 behind it. So if the value in cell C5 is 1234. The first time it save it will be 1234-1.xls If the same number is used again it will be 1234-2.xls and so on and so forth. The problem I'm running into is that when file 1234-2.xls gets moved to another directory I need the macro to search that directory also so that my next file is 1234-3 and not 1234-2 again. I hope that makes more sense. Please let me know if I can provide any more info. Thanks again.