overwrite Excel SaveAs function from File menu

[susie]

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]

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.