Finds and replaces a text string if the string is found in any rtf word document within a folder-CodePudding

When running the vba code below on a folder that contains approximately 100 rft word documents, I receive the following VBA error.

"Run-time error '4605' This method or property is not available because the object refers to a protected area of the document."

The vba code that I am running is several years old and may no longer be compatible or the best code for this job but it worked perfectly a few years ago (last time it was ran).

The vba code uses find and replace to update any rtf documents within the folder that meets the find and replace conditions. The code searches the body of each rtf document for the word CAT and replaces with DOG. After receiving the error and looking at debug, the last line of the vba code is highlighted as the error --> .Execute Replace:=wdReplaceAll

Many of the documents within the folder are 'protected from unintentional editing. You may only fill in the forms region' -- this can be overwridden from within the actual file by selecting the 'Stop Protection' button. There is nothing in my current vba code to override this protection so that may be the issue. Is there a piece of code that could be added which would stop enforcing 'Restrict Editing' when the code is running the 'Start Enforcing Protection' on the files after the code finishes? That may be the issue but I have no idea how to write that into the vba code. Here is a screenshot of the 'Restrict Editing' protection that is checked on many of the documents:Screenshot of Restrict Editing restrictions on some of the files

The restriction that is checked under 'Restrict Editing' in many of the documents is 'Allow only this type of editing in the document: FILLING IN FORMS'. My guess is the macro would need to uncheck this on each document within the folder if that box is checked then recheck that box near the end of the macro. Any ideas how to do that?

Full code is pasted below. Any help would be greatly appreciated. I will not forget to mark best answer and will reply to all that respond. Thank you in advance and I hope this finds you well.

Sub UpdateBODY()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document, Rng As Range
Dim Sctn As Section, HdFt As HeaderFooter, Fnd As String, Rep As String
Fnd = "CAT": Rep = "DOG"
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.rtf", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=True)
  With wdDoc
    '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
    .Close SaveChanges:=True
  End With
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

Sub RngFndRep(Rng As Range, Fnd As String, Rep As String)
With Rng.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Format = False
  .Forward = True
  .Wrap = wdFindContinue
  .Text = Fnd
  .Replacement.Text = Rep
  .MatchCase = True
  .MatchAllWordForms = False
  .MatchWholeWord = False
  .MatchWildcards = False
  .Execute Replace:=wdReplaceAll
End With
End Sub

Tried running the find and replace macro on a folder full of rtf documents. Each attempt results in the 4605 error noted in the header of the post.

CodePudding user response：

You need to use the Document.Protect function. The first step is to record the current ProtectionType as this will enable reapplying it before the document is closed. The next step is to check the protection type to see if the document needs to be unprotected. Finally, before closing the docuemnt, the recorded protection type needs to be checked to see if protection needs to be re-applied.

NOTE: this code will only work if the protection has been applied without a password. If a password has been used it will need to be passed to the protect method. See documentation: https://learn.microsoft.com/en-us/office/vba/api/Word.document.protect

Sub UpdateBODY()
    Application.ScreenUpdating = False
    Dim strFolder As String, strFile As String, wdDoc As Document, Rng As Range
    Dim Sctn As Section, HdFt As HeaderFooter, Fnd As String, Rep As String
    Dim protection As Long
    Fnd = "CAT": Rep = "DOG"
    strFolder = GetFolder
    If strFolder = "" Then Exit Sub
    strFile = Dir(strFolder & "\*.rtf", vbNormal)
    While strFile <> ""
        Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=True)
        With wdDoc
            'record current protection type and unprotect if necessary
            protection = .ProtectionType
            If protection <> wdNoProtection Then .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 protection <> wdNoProtection Then .Protect protection
            .Close SaveChanges:=True
        End With
        strFile = Dir()
    Wend
    Set wdDoc = Nothing
    Application.ScreenUpdating = True
End Sub