overwrite Excel SaveAs function from File menu
I think that this'll work, but test it.
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim myFileName As Variant
Dim okFolderName As String
Dim resp As Long
okFolderName = "U:\company"
'we'll do the saving--stop excel from trying to do it.
Cancel = True
If SaveAsUI Then
myFileName = Application.GetSaveAsFilename _
(InitialFileName:=ThisWorkbook.FullName, _
filefilter:="Excel Files, *.xls")
If myFileName = False Then
Exit Sub
Else
If LCase(Left(myFileName, Len(okFolderName))) < LCase(okFolderName)
Then
MsgBox "Cannot save here"
Exit Sub
Else
'do nothing
End If
End If
Else
myFileName = ThisWorkbook.FullName
End If
resp = vbYes
If SaveAsUI Then
If Dir(myFileName) < "" Then
resp = MsgBox(prompt:="Overwrite existing file?", Buttons:=vbYesNo)
End If
End If
If resp = vbYes Then
With Application
.EnableEvents = False
.DisplayAlerts = False
End With
Me.SaveAs Filename:=myFileName, FileFormat:=xlNormal
With Application
.DisplayAlerts = True
.EnableEvents = True
End With
End If
End Sub
This code goes in the ThisWorkbook module--not a general module.
susie wrote:
When user click on SaveAs from File menu in excel, I would
like to send a message to the user that they are not
allowed to rename the file with a new file name to
U:\company and Save button will be disabled right away.
However the message should not popup if the user save the
file to any foler other than U:\company
Any idea on how to accomplish this?
Thank you.
Susie
--
Dave Peterson
|
