Gotcha. The trick is to ask before the lady asks herself:
Sub test()
Dim NameAk As String
Dim NewName As Variant
NameAk = Sheets(1).Name & ".xls"
NewName = Application.GetSaveAsFilename( _
InitialFileName:=ActiveWorkbook.Path & "\" & _
NameAk, FileFilter:="Excel Workbooks (*.xls), *.xls")
If NewName < False Then
If Dir(NewName) < "" Then
Select Case MsgBox("File Exists. Overwrite ?", vbYesNoCancel +
vbQuestion)
Case vbYes
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=NewName,
FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True
Case vbNo
Do
NewName = Application.GetSaveAsFilename( _
InitialFileName:=ActiveWorkbook.Path & "\" & _
NameAk, FileFilter:="Excel Workbooks (*.xls), *.xls")
If NewName = False Then Exit Sub
Loop Until Dir(NewName) = ""
ActiveWorkbook.SaveAs Filename:=NewName,
FileFormat:=xlWorkbookNormal
Case Else
Exit Sub
End Select
Else
ActiveWorkbook.SaveAs Filename:=NewName,
FileFormat:=xlWorkbookNormal
End If
End If
End Sub
HTH. Best wishes Harald
"Der " skrev i melding
...
Hi
when th second box occures I want:
1. OK- overwrite the existing file
2. Cancel- exit and do not save
3. No- get the message box "If you do not want to overwrite existing
file please give a different name for the new file" and hen come back
to Save as box.
---
Message posted from http://www.ExcelForum.com/