阻止打开保存在特定位置的Excel工作簿

Question

我正在尝试阻止授权用户以外的用户打开工作簿，如果工作簿是从工作簿保存的位置打开的。我想要的是让用户将工作簿复制到另一个位置，然后打开它。我已经将下面的代码用于 Access 数据库，但我不确定如何针对 Excel 对其进行调整。有人可以帮忙吗？

Option Compare Database
Private Function AutoExec()
' Use Macro to run code and use the AutoExec() name
If VBA.InStr(1, CurrentDb.Name, "G:") _
Or VBA.InStr(1, CurrentDb.Name, "\NetWorkLocation") Then
Select Case VBA.StrConv(VBA.Environ("username"), vbLowerCase)
Case "username1", "username2", "username3"
Case Else
VBA.MsgBox "Copy and paste this database to your desktop." _
& vbCrLf & "You may not open it from this location."
DoCmd.CloseDatabase
End Select
End If
End Function

Answer 1

如果将其放入要限制访问的工作簿的ThisWorkbook模块中，它应该可以工作。

Private Sub Workbook_Open()
If InStr(ThisWorkbook.path, "G:") > 0 _
Or InStr(ThisWorkbook.path, "\NetWorkLocation") > 0 Then
Select Case LCase(Environ("username"))
Case "username1", "username2", "username3"
Case Else
MsgBox "Copy and paste this spreadsheet to your desktop." & _
vbCrLf & "You may not open it from this location."
ThisWorkbook.Close savechanges:=False
End Select
End If
End Sub

Answer 2

这是完成的代码，我已经确认它可以工作。

Sub Workbook_Open()
If VBA.InStr(1, Application.Workbook.Path, "G:") > 0 _
Or VBA.InStr(1, Application.Workbook.Path, "\NetWorkLocation") > 0 Then
Select Case VBA.StrConv(VBA.Environ("username"), vbLowerCase)
Case "username1", "username2", "username3"
Case Else
VBA.MsgBox "Copy and paste this workbook to your desktop." _
& vbCrLf & "You may not open it from this location."
ActiveWorkbook.Close 
End Select
End If
End Function

Answer 3

ThisWorkbook.Path 返回 "G："，而不是 "G：\" 当文件保存在 "G：" 的根目录下时。 去掉"\"，你就会变成金色。

仅供参考 - 我通过将代码放入它自己的函数中以使其更易于调试来调试它(不必继续打开和关闭文件来调用函数(，然后逐步完成该函数。 第一个"If"语句失败，对用户的检查从未发生，所以我向ThisWorkbook.Path添加了一个监视，并看到它返回"G："而不是G：\"。 这是约瑟夫的更正函数：

Sub Workbook_Open()
If VBA.InStr(1, Application.Workbook.Path, "G:") > 0 _
Or VBA.InStr(1, Application.Workbook.Path, "\NetWorkLocation") > 0 Then
Select Case VBA.StrConv(VBA.Environ("username"), vbLowerCase)
Case "username1", "username2", "username3"
Case Else
VBA.MsgBox "Copy and paste this workbook to your desktop." _
& vbCrLf & "You may not open it from this location."
ActiveWorkbook.Close 
End Select
End If
End Function