Help with altering a SaveAs macro . . .

[Guest]

Dave Peterson gave me a macro to save a workbook and it works great (much
thanks Dave!). But I now realize I need it to suggest a copy name for the
active workbook and then return to the active workbook after saving, not the
copy. I still want all the functionality that Dave's Macro gives, . . . but I
don't want my users saving over the original file by mistake.

For example, the active workbook is named: "PFSNov.xls" The macro would
suggest or pre-load the name "PFSNov_Copy.xls" save the workbook to a place
the user specifies, but return to "PFSNov.xls" after saving.

Dave's macro is as follows:

Option Explicit
Sub testme01()
Dim myFileName As Variant
Dim OkToSave As Boolean
Dim resp As Long

Do
myFileName = Application.GetSaveAsFilename _
(filefilter:="Excel files, *.xls")
If myFileName = False Then
Exit Sub
End If

OkToSave = True
If Dir(myFileName) = "" Then
'do nothing special
Else
resp = MsgBox(prompt:="Overwrite Existing file?", _
Buttons:=vbYesNoCancel)
Select Case resp
Case Is = vbCancel
MsgBox "Try again later"
Exit Sub
Case Is = vbNo
OkToSave = False
End Select
End If

If OkToSave Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=myFileName, _
FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True
Exit Do
End If
Loop

End Sub

I've tried playing around and modifying it, but being very new to this, all
I get is a variety of different error messages. Any ideas?

WillRn

 

[Tom Ogilvy]

Dim OkToSave As Boolean
Dim resp As Long
Dim sName as String
Dim myFileName as String
sName = Left(ActiveWorkbook.Name,len( _
ActiveWorkbook.Name, - 4) & "_Copy.xls"
ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path

myFileName = Application.GetSaveAsFilename -
(InitialFilename:=sName, _
filefilter:="Excel files, *.xls")
if sName = "False" then
exit sub
End if
If Ucase(MyFileName) = Ucase(ActiveWorkbook.FullName) then
msgbox "You can't overwrite this file, save using a different name"
exit sub
End if
OkToSave = True
If Dir(myFileName) = "" Then
'do nothing special
Else
resp = MsgBox(prompt:="Overwrite Existing file?", _
Buttons:=vbYesNoCancel)
Select Case resp
Case Is = vbCancel
MsgBox "Try again later"
Exit Sub
Case Is = vbNo
OkToSave = False
End Select
End If
If OkToSave then
if dir(MyFileName) <> "" then
Kill MyFileName
End if
Activeworkbook.SaveCopyAs MyFileName
End if

Untested, so it could contain typos.

 

[Guest]

Corrected just a couple of typos and it works great!
Thanks Tom!

WillRn