SaveAs Problem
Thank you Sharad, it works ! There is no end to man's ingenuity !
I had managed a workaround - shown below as a matter of interest.
Sub UserFileSave()
Dim Fname, Suggestion, Hdr
Suggestion = "MyFile " & Format(Date, "dd mmm yy")
Hdr = "Please choose a Location and Name then click Save."
On Error GoTo ERRH
Fname = Application.GetSaveAsFilename(Suggestion, fileFilter:="Excel
File(*.xls), *.xls)", Title:=Hdr)
If Fname = False Then
'Handle Cancel
'UserCancel
Else
ThisWorkbook.SaveAs Filename:=Fname
End If
Exit Sub
ERRH:
On Error Goto 0
MsgBox "Try another Name"
UserFileSave
End Sub
Thanks again and regards,
Don
"Sharad Naik" wrote in message
...
Try below code. Changes marked with '<-----
Sub UserFileSave()
Dim Fname, Suggestion, Hdr
Dim fs '<-------
Suggestion = "MyFile " & Format(Date, "dd mmm yy")
Hdr = "Please choose a Location and Name then click Save."
getFname: '<----- added label
Fname = Application.GetSaveAsFilename(Suggestion, fileFilter:="Excel File
(*.xls), *.xls)", Title:=Hdr)
If Fname = False Then
'Handle Cancel
UserCancel
Else
'<--------- new lines below
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(Fname) Or fs.FlieExists(Fname & ".xls") Then
Select Case MsgBox ("File " & Fname & " already exists. " _
& "Do you want to replace it?" , vbYesNoCancel)
Case vbYes
On Error Resume Next
Kill Fname
Kill Fname & ".xls"
On Error GoTo 0
Case vbNo
GoTo getFname: 'get a new name then
Case vbCancel
Exit Sub 'used canceled
End Select
End If
ThisWorkbook.SaveAs FileName:=Fname
End If
End Sub
"Don Lloyd" wrote in message
...
Hi Norman,
I've tried your code as is.
When the message saying that the file already exists shows and I choose
not to replace it, the error 1004 appears, which is fatal if not handled.
regards,
Don
"Norman Jones" wrote in message
...
Hi Don,
Revising your posted nacro to reflect my suggestion, gives:
Sub UserFileSave()
Dim Fname, Suggestion, Hdr
Suggestion = "MyFile " & Format(Date, "dd mmm yy")
Hdr = "Please choose a Location and Name then click Save."
Fname = Application.GetSaveAsFilename(Suggestion, _
fileFilter:="Excel File(*.xls), *.xls)", Title:=Hdr)
If Fname < False Then
ThisWorkbook.SaveAs Filename:=Fname
Else
' User Cancelled - dont save
End If
End Sub
This did not error for me.
---
Regards,
Norman
"Don Lloyd" wrote in message
...
Thank you Norman and Claud
Unfortunately neither method works properly as the error keeps coming
up when the offer to replace the file is declined.
For the time being I've managed to overcome it with "unqualified" error
trapping and then using recursion.
Thanks for your time and effort.
regards,
Don
|