VBA Word：删除打开时的编辑限制，关闭时再次限制

Question

Is it possible to set a macro that would trigger each time I open a word document and check if it has an editing restriction. If so, try password from a list of passwords (hardcoded). In case one password is successfull, keep it in memory, remove restriction, and re-apply the restriction when I close the document.

In this way, if I always use the same password for the documents I use and restrict, I could open them on my computer as if there was no restriction, but the restriction would still apply to other users.

Note: the macro in Private Sub Document_Open() would need to trigger on all documents I open from my computer only. Documents must be .docx and not .docm.

Thank you.

Answer 1

Not a code writing service but I kinda like the idea so here goes; this should get you off to a good start.

Note1: You will need to put this into a .dotm file and ultimately save as a global template on your PC (google).

Note2: This will fail if you open more than 1 doc because only 1 password is stored - you could write the password as a document property (which you would retrieve & delete before saving and relocking).

Depending on whether or not you are happy to add code to the Normal.dotm template (personally I'm not) will influence how you do this.

If NOT using Normal.dotm then you will need to setup a global template AND trigger the code by creating your own application events as described here: https://wordmvp.com/FAQs/MacrosVBA/PseudoAutoMacros.htm

If using Normal.dotm then in ThisDocument add:

Private Sub Document_Open()
    MsgBox ActiveDocument.Name
    Dim oDoc As Object
    Set oDoc = ActiveDocument
    unlocker oDoc
End Sub

And (for testing) in a regular module add the following (you'll likely want to split this into separate units of code later):

Sub unlocker(ByVal docToUnlock As Document)
    If Not docToUnlock.Type = wdTypeDocument Then
        ' this is a template, don't try anything
        MsgBox "Not a doc"
        GoTo endOfSub
        Else
        MsgBox "Is a doc"
    End If


    Dim passWords() As String
    passWords = Split("pw1,pw2,pw3", ",")

    Dim iLoop As Long
    iLoop = LBound(passWords)

    On Error GoTo err_Test:

    Do While Not ActiveDocument.ProtectionType = wdNoProtection
        If iLoop > UBound(passWords) Then Exit Do

        oldpassword = passWords(iLoop)

        ActiveDocument.Unprotect oldpassword
        iLoop = iLoop + 1
    Loop

    If Not ActiveDocument.ProtectionType = wdNoProtection Then
        ' unable to unlock document, quit
        oldpassword = vbNullString
        MsgBox "Failed to Unlock"
        GoTo endOfSub
    Else
        MsgBox "Unlocked"
    End If

    ' Do Stuff

    If Not oldpassword = vbNullString Then
        ActiveDocument.Protect wdAllowOnlyReading, Password:=oldpassword
    End If

endOfSub:
    Exit Sub

err_Test:
    If Err.Number = 5485 Then
        ' ignore error due to wrong password
        Err.Clear
        Resume Next
    Else
        ' handle unexpected error
    End If

End Sub