J
jnf40
Hello all,
I have a workbook that saves a file with the following code:
Function DoesPathExist(myPath As String) As Boolean
Dim TestStr As String
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If
TestStr = ""
On Error Resume Next
TestStr = Dir(myPath & "nul")
On Error GoTo 0
DoesPathExist = CBool(TestStr <> "")
End Function
Dim myParentFolder As String
Dim myFolder As String
myParentFolder = "U:\"
Application.DisplayAlerts = False
If DoesPathExist(myParentFolder) Then
On Error Resume Next
MkDir myParentFolder & mycsj
MkDir myParentFolder & mycsj & "\Pay Reports"
MkDir myParentFolder & mycsj & "\Pay Reports" & "\" &
Range("name")
On Error GoTo 0
myFolder = myParentFolder & mycsj & "\Pay Reports" & "\" &
Range("name")
myFileName = Range("file")
myFileName = myFolder & "\" & myFileName & ".xls"
ActiveWorkbook.SaveAs Filename:= _
myFileName, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
MsgBox "File Saved to " & myFileName
Else
myParentFolder = "C:\"
On Error Resume Next
MkDir myParentFolder & mycsj
MkDir myParentFolder & mycsj & "\Pay Reports"
MkDir myParentFolder & mycsj & "\Pay Reports" & "\" &
Range("name")
On Error GoTo 0
myFolder = myParentFolder & mycsj & "\Pay Reports" & "\" &
Range("name")
myFileName = Range("file")
myFileName = myFolder & "\" & myFileName & ".xls"
ActiveWorkbook.SaveAs Filename:= _
myFileName, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
MsgBox "File Saved to " & myFileName
End If
Application.DisplayAlerts = True
End Sub
This works fine, however when I need to create a new workbook to continue
where the old one left off it simply overwrites the old one. I need it to
have the same name only add a "2" to the end of the old file name, and if
another is created then add a "3" and so on, any help is greatly appreciated.
I have a workbook that saves a file with the following code:
Function DoesPathExist(myPath As String) As Boolean
Dim TestStr As String
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If
TestStr = ""
On Error Resume Next
TestStr = Dir(myPath & "nul")
On Error GoTo 0
DoesPathExist = CBool(TestStr <> "")
End Function
Dim myParentFolder As String
Dim myFolder As String
myParentFolder = "U:\"
Application.DisplayAlerts = False
If DoesPathExist(myParentFolder) Then
On Error Resume Next
MkDir myParentFolder & mycsj
MkDir myParentFolder & mycsj & "\Pay Reports"
MkDir myParentFolder & mycsj & "\Pay Reports" & "\" &
Range("name")
On Error GoTo 0
myFolder = myParentFolder & mycsj & "\Pay Reports" & "\" &
Range("name")
myFileName = Range("file")
myFileName = myFolder & "\" & myFileName & ".xls"
ActiveWorkbook.SaveAs Filename:= _
myFileName, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
MsgBox "File Saved to " & myFileName
Else
myParentFolder = "C:\"
On Error Resume Next
MkDir myParentFolder & mycsj
MkDir myParentFolder & mycsj & "\Pay Reports"
MkDir myParentFolder & mycsj & "\Pay Reports" & "\" &
Range("name")
On Error GoTo 0
myFolder = myParentFolder & mycsj & "\Pay Reports" & "\" &
Range("name")
myFileName = Range("file")
myFileName = myFolder & "\" & myFileName & ".xls"
ActiveWorkbook.SaveAs Filename:= _
myFileName, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
MsgBox "File Saved to " & myFileName
End If
Application.DisplayAlerts = True
End Sub
This works fine, however when I need to create a new workbook to continue
where the old one left off it simply overwrites the old one. I need it to
have the same name only add a "2" to the end of the old file name, and if
another is created then add a "3" and so on, any help is greatly appreciated.