Sub macro records current document protection, allows find and replace, then reapplies protection if-CodePudding

I have a find and replace macro that searches through folders and subfolders for word rtf document that contain ABC TEXT then updates to XYZ TEXT.

When running this on a folder with several hundred documents, I keep getting this error:

'Run-time error 4605 The Protect Method or property is not available because the document is already protected'

After receiving the error then running debugger, the following is highlighted in the code: '.Protect wdNoProtection'

There is a sub that I 'thought' was checking current Protection Type then unprotecting if necessary, then applying the same Protection Type back to each document before saving. Basically putting the document protections back as they were (same protection or no protection) after the find and replace is complete.

Is there something missing in this proc or a way to skip this error and move to the next file if an error occurs? This error prevents any find/replaces, once this error is encountered, everything grinds to a stop. Here is the relevant part of the macro where the protection type is checked and reapplied which is where I 'think' the issue might be and as noted above, debugger highlights the portion in code @ '.Protect wdNoProtection'

Sub UpdateDocuments(oFolder As String)
Dim strFile As String, wdDoc As Document, Rng As Range
Dim Sctn As Section, HdFt As HeaderFooter, Prot As Long
Const Fnd As String = "Signature": Const Rep As String = "***Electronically Signed***"
strFile = Dir(oFolder & "\*.rtf", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=oFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    'record current protection type and unprotect if necessary
    Prot = .ProtectionType
    If Prot <> wdNoProtection Then .Protect wdNoProtection  'Debugger highlights .Protect wdNoProtection
    'Process everything except headers & footers
    For Each Rng In .StoryRanges
      Select Case Rng.StoryType
        Case wdPrimaryFooterStory, wdFirstPageFooterStory, wdEvenPagesFooterStory, _
          wdPrimaryHeaderStory, wdFirstPageHeaderStory, wdEvenPagesHeaderStory
        Case Else
          Call RngFndRep(Rng, Fnd, Rep)
      End Select
    Next
    'reapply protection if necessary
    If Prot <> wdNoProtection Then .Protect Prot
    .Close SaveChanges:=True
  End With
  strFile = Dir()
Wend
Set wdDoc = Nothing
End Sub

Any help to prevent this error or way to ignore it and move on would be greatly appreciated.

Attempted running code several times but eact time ran, the code finds a file that throws the error noted above which stops the macro.

CodePudding user response：

The line:

If Prot <> wdNoProtection Then .Protect wdNoProtection

should be:

If Prot <> wdNoProtection Then .Unprotect

Note that if the protection includes a password, you'll need to supply that - and re-apply it later. For a demonstration, see:

https://www.msofficeforums.com/32288-post4.html

and, if all documents use the same password:

https://www.msofficeforums.com/word-vba/27809-code-add-new-row-table.html