Option Explicit
Function SaveWithParens(SomeWorkbook As Workbook, myPath As String, _
myFileName As String) As Boolean
'some variables
Dim myNewFileName As String
Dim iCtr As Long
Dim TestStr As String
'add a backslash if you didn't include it
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If
'Check to see if it's a valid folder
'every folder has a nul(l) device associated with it.
'if Nul isn't returned, then the path wasn't correct
'either a typo or the folder or drive didn't really exist
'clean out a string variable
TestStr = ""
'Mr. VBA, ignore any error, I'll handle it myself
On Error Resume Next
TestStr = Dir(myPath & "nul")
'Go back to checking Mr. VBA!
On Error GoTo 0
'if that test variable is still "", then the drive/folder wasn't found
If TestStr = "" Then
'MsgBox "Invalid drive/folder!"
'send the bad news back to the calling procedure
SaveWithParens = False
'and get the heck out
Exit Function
End If
'initialize my counter to 0
iCtr = 0
Do
'start with 1, then increment in each loop
iCtr = iCtr + 1
'build that new filename
myNewFileName = myPath & myFileName & "(" & iCtr & ")" & ".xls"
'check to see if the with that name already exists
'teststr will return the filename (w/o the path if it's there)
TestStr = ""
'Never mind any error, Mr. VBA
On Error Resume Next
TestStr = Dir(myNewFileName)
'go back to checking, Mr. VBA
On Error GoTo 0
If TestStr = "" Then
'that file name isn't used
'but who knows if the save will work
'maybe it's on a restricted access drive
'maybe the drive is out of space
'mr vba, you know what not to care about!
On Error Resume Next
'try saving the workbook that was passed to the function
'using the new filename
SomeWorkbook.SaveAs Filename:=myNewFileName, _
FileFormat:=xlWorkbookNormal
'was there an error
If Err.Number <> 0 Then
'clear the error
Err.Clear
'return the bad news
SaveWithParens = False
Else
'it worked ok!!!
'send the good news back
SaveWithParens = True
End If
'back to you mr. VBA
On Error Goto 0
'we're done here, get the heck out of the loop
Exit Do
End If
Loop
End Function
Sub testme()
'define some variables
Dim myFN As String
Dim myDefaultName As String 'must be good!
Dim ThisPath As String
Dim WorkedOk As Boolean
'where do you want to save it?
ThisPath = "C:\my documents\excel\test\"
'this has to be a good name--I'm not sure how you got:
'CT08-0001_Invalid Name (1)
myDefaultName = "somenamehere"
'here's an invalid name (in windows, at least)
myFN = "qqewr:::.xls"
'the saveas could fail, but I don't want the code to stop.
'I'll check for errors myself.
On Error Resume Next
ActiveWorkbook.SaveAs Filename:=ThisPath & myFN, _
FileFormat:=xlWorkbookNormal
'was there an error?
If Err.Number <> 0 Then
'clear the error
Err.Clear
'call savewithparens() with all the stuff I need to know
'what workbook should be save, where, and pass it a good filename
WorkedOk = SaveWithParens(SomeWorkbook:=ActiveWorkbook, _
myPath:=ThisPath, myFileName:=myDefaultName)
'did the function work ok
If WorkedOk Then
MsgBox "Worked ok!"
Else
MsgBox "Something else went wrong"
End If
End If
'If there are any errors after this, I want to know!
