Sdc,
code should be placed in ThisWorkbook
InstrRev only works with Excel2000 or newer.
warnings and/or exits should be amended to suit your needs.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)
Dim sName$, sPath$
If SaveAsUI Then
Cancel = True
sPath = Application.GetSaveAsFilename( _
FileFilter:="Excel Workbooks (*.xls), *.xls")
If sPath = "False" Then
Exit Sub 'User cancelled
ElseIf sPath = ThisWorkbook.FullName Then
ThisWorkbook.Save
Else
sName = Mid(sPath, InStrRev(sPath, "\") + 1)
sPath = Left(sPath, InStrRev(sPath, "\"))
If sName <> ThisWorkbook.Name Then
If vbOK = MsgBox( _
"Warning: will be saved to indicated path, " & _
"but file cannot be renamed", vbOKCancel) Then
If sPath = ThisWorkbook.Path & "\" Then
ThisWorkbook.Save
Else
On Error Resume Next 'need for cancel overwrite
Application.EnableEvents = False 'avoid triggering self
ThisWorkbook.SaveAs sPath & ThisWorkbook.Name
Application.EnableEvents = True
End If
End If
End If
End If
End If
End Sub
keepITcool
< email : keepitcool chello nl (with @ and .) >
< homepage:
http://members.chello.nl/keepitcool >