Защитить общий доступ к другой книге

Question

Я пытаюсь создать новую защиту для книги Excel, так как вы знаете, что защита Excel очень слабая. Теперь мне нужно установить защиту для совместного использования, и это будет сделано для другой книги, а не для активной книги

Предположим, что код находится в Test.xlsm, и мне нужно защитить закрытую книгу Sample.xlm Это код, который я created

Dim wb As Workbook

Sub DoProtectionTask()
    Dim sPath As String
    sPath = ThisWorkbook.Path & "\Sample.xlsm"
    Set wb = Workbooks.Open(sPath)
    ProtectSharing True, "123", "456"
    wb.Close True
End Sub

Private Sub ProtectSharing(ByVal b As Boolean, ByVal sPass1 As String, ByVal sPass2 As String)
    Dim x
    If b Then
        On Error GoTo Skipper
        Application.DisplayAlerts = False
        Application.EnableEvents = False
            wb.ProtectSharing Password:=sPass1, SharingPassword:=sPass2
Skipper:
        Application.DisplayAlerts = True
        Application.EnableEvents = True
    Else
        x = InputBox("Enter Admin Password")
        If x <> sPass1 Then MsgBox "Invalid Password. Contact The Workbook Owner", vbExclamation: Exit Sub
        wb.UnProtectSharing sPass1
    End If
End Sub

Он работает и ошибки для кода, но при открытии Sample.xlsm после запуска кода я не обнаружил, что книга защищена от совместного использования. Хотя этот метод работает на ThisWorbook или ActiveWorkbook

Есть идеи?

Answer 1

Я не уверен, что правильно понял, но мне кажется, что этот код wb.UnProtectSharing sPass1 должен выглядеть так: wb.UnProtectSharing sPass2

весь код:

Dim wb As Workbook

Sub DoProtectionTask()
    Dim sPath As String
    sPath = ThisWorkbook.Path & "\Sample.xlsm"
    Set wb = Workbooks.Open(sPath)
    ProtectSharing True, "123", "456"
    wb.Close True
End Sub

Private Sub ProtectSharing(ByVal b As Boolean, ByVal sPass1 As String, ByVal sPass2 As String)
    Dim x
    If b Then
        On Error GoTo Skipper
        Application.DisplayAlerts = False
        Application.EnableEvents = False
            wb.ProtectSharing Password:=sPass1, SharingPassword:=sPass2
Skipper:
        Application.DisplayAlerts = True
        Application.EnableEvents = True
    Else
        x = InputBox("Enter Admin Password")
        If x <> sPass1 Then MsgBox "Invalid Password. Contact The Workbook Owner", vbExclamation: Exit Sub
        wb.UnProtectSharing sPass2
    End If
End Sub