Запрет открытия книги Excel, сохраненной в определенном месте - PullRequest
Новая
       6

Запрет открытия книги Excel, сохраненной в определенном месте

0 голосов
/ 11 сентября 2018

Я пытаюсь запретить пользователям, кроме авторизованных, открывать рабочую книгу, если она открывается из того места, в котором она была сохранена.Я хочу, чтобы пользователь скопировал книгу в другое место и затем открыл ее.Я использовал код ниже для баз данных 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

Ответы [ 3 ]

0 голосов
/ 11 сентября 2018

Это завершенный код, и я подтвердил, что он работает. 

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
0 голосов
/ 12 сентября 2018

ThisWorkbook.Path возвращает «G:», а не «G: \», когда файл сохраняется в корне «G:».Бросай "\" и ты будешь золотым.

К вашему сведению - я отладил это, поместив код в свою собственную функцию, чтобы упростить отладку (не нужно было открывать и закрывать файл для вызова функции), а затем прошел через эту функцию.Первый оператор «If» не выполнен, и проверка для пользователя никогда не выполнялась, поэтому я добавил Watch в ThisWorkbook.Path и увидел, что он возвращает «G:», а не G: \ ». Вот функция JosephD с исправлением: 

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
0 голосов
/ 11 сентября 2018

Если вы уроните это в модуль 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
...