Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Closed Thread
 
Thread Tools Display Modes
  #1  
Old 10-09-2022, 02:16 PM
macropod's Avatar
macropod macropod is offline Redact a Word Document Windows 10 Redact a Word Document Office 2016
Administrator
Redact a Word Document
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default Redact a Word Document

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.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Closed Thread

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Redact a pdf copy/pasted into word jbrow1 Word 9 10-05-2021 09:56 PM
How to redact words listed in one document from the current document AlanofBayCourt Word VBA 0 10-31-2019 03:00 AM
Macro to extract bookmarked data from Word document and insert into another Word Document VStebler Word VBA 3 05-03-2018 05:02 PM
Redact a Word Document Linking one word document to a 'master' word document - even if files are in private drive mb3344 Word 2 08-06-2016 07:10 PM
Redact a Word Document Word document with Macros with trusted locatin versus Word document 1997-2003 Cardinal2 Word 1 11-30-2015 07:42 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 08:06 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft