SaveAs Problem

[Don Lloyd]

Hi All,

Happy New Year - belated but well meant

I'm programmatically using the SaveAs Dialog Box to allow the user to decide
where to save a file.

If the chosen path already exists, SaveAs points this out.
Fine, except that, if the option to not overwrite the file is chosen, an
error 1004 message appears. Clicking Help helpfully displays a blank Help
screen.

In short, how do I handle this error. Code example as follows.

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
'Handle Cancel
UserCancel
Else
ThisWorkbook.SaveAs FileName:=Fname
End If
End Sub

Regards,
Don
( XL97 Win98 / XL2003 WinXp )

 

[Norman Jones]

Hi Don,

Try:

If Fname <> False Then
ThisWorkbook.SaveAs Filename:=Fname
Else
' User Cancelled - don't save
End If

 

[Claud Balls]

This is kind of hokey, and a user could still induce the error, but it
gives you a little buffer.

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
'Handle Cancel
'UserCancel
ElseIf Dir(Fname) = "" Then
ThisWorkbook.saveas Filename:=Fname
Else
response = MsgBox("File Exists, Save anyway?", vbYesNo)
If response = vbYes Then
ThisWorkbook.saveas Filename:=Fname
Else
Exit Sub
End If
End If
End Sub

 

[Don Lloyd]

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

 

[Norman Jones]

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.

 

[Don Lloyd]

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

 

[Sharad Naik]

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]

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