Microsoft Office Forums - View Single Post

macropod · 10-09-2022, 02:16 PM

One occasionally needs to redact a Word Document, so that sensitive information is concealed. To that end, one might first highlight the blocks of text to be redacted.

The following macro redacts all yellow-highlighted content in the active document, replacing that content with essentially empty, black-highlighted, blocks having the same print width.

Code:

Sub RedactDocument()
Application.ScreenUpdating = False
'Sourced from: https://www.msofficeforums.com/word-vba/49782-redact-word-document.html
Dim wdPage As Page, wdRct As Rectangle, wdLine As Line, Rng As Range, sWdth As Single
For Each wdPage In ActiveDocument.ActiveWindow.Panes(1).Pages
  For Each wdRct In wdPage.Rectangles
    For Each wdLine In wdRct.Lines
      Set Rng = wdLine.Range
      With wdLine.Range
        If .Characters.Last.Text Like "[ " & Chr(160) & Chr(9) & "-" & Chr(13) & "]" Then
          .Characters.Last.HighlightColorIndex = wdNoHighlight
        End If
        With .Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Highlight = True
          .Wrap = wdFindStop
          .Text = ""
          .Replacement.Text = ""
          .Execute
        End With
        If .Find.Found = True Then
          If .End > Rng.End Then .End = Rng.End
        End If
        Do While .Find.Found = True
          If .InRange(Rng) = False Then Exit Do
          If .HighlightColorIndex = wdYellow Then
            .Fields.Unlink
            .HighlightColorIndex = wdBlack
            sWdth = .Characters.Last.Next.Information(wdHorizontalPositionRelativeToPage) - _
              .Characters.First.Information(wdHorizontalPositionRelativeToPage)
            .Text = Chr(160) & Chr(160)
            .FitTextWidth = sWdth
          End If
          .Collapse wdCollapseEnd
          .Find.Execute
        Loop
      End With
    Next
  Next
Next
Application.ScreenUpdating = True
End Sub

For PC macro installation & usage instructions, see: Installing Macros
For Mac macro installation & usage instructions, see: Word:mac - Install a Macro

Note:1 Do not run the above macro on the original document unless you intend for the redacted content to become permanently unavailable - even to you - once the redactions are saved.

Note:2 The above macro does not remove metadata elements such as the document’s title, properties, author name, the dates on which the document was created, modified, or printed, hidden text and so on, for which one should use the Document Inspector.