You need to change the Drive and Folder Path in the code below!
Also, change "\AndWhatEver" to what ever you want added to the default Workbook name, Note: The "\" before the "AndWhatEver" must stay!
Public Sub mySaveAs()
'Open the SaveAs dialog.
Dim fileSaveName As Variant, myPath, myFName$
ChDrive "U"
ChDir "U:\Excel\Test"
myPath = CurDir
myFName = myPath & "\AndWhatEver" & "_" & ActiveWorkbook.Name & ".xls"
fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Text Files (*.xls), *.xls", _
InitialFileName:=myFName)
If fileSaveName <> False Then
ActiveWorkbook.SaveAs Filename:=fileSaveName
End If
End Sub
If you have the initial Workbook opened as a Read-Only copy then use this version of the code:
Public Sub mySaveAs()
'Open the SaveAs dialog.
Dim fileSaveName As Variant, myPath, myFName$
Dim fs As Variant, f As Variant
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(fs.GetFileName(ActiveWorkbook.FullName))
'Re-Set ReadOnly! Note: "1" is the Read Only code!
If f.Attributes And 1 Then f.Attributes = f.Attributes - 1
ChDrive "U"
ChDir "U:\Excel\Test"
myPath = CurDir
myFName = myPath & "\AndWhatEver" & "_" & ActiveWorkbook.Name & ".xls"
fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Text Files (*.xls), *.xls", _
InitialFileName:=myFName)
If fileSaveName <> False Then
ActiveWorkbook.SaveAs Filename:=fileSaveName
End If
End Sub