#1
|
|||
|
|||
How to redact words listed in one document from the current document
I want to share this with you in case you ever need to redact sensitive words from a word document. You make a space delimited dotx document with the words to redact. If it contains words that are not in the document its not a problem. You edit the macro to give the location and name of your word list. You then make the document to be redacted the current document and run the macro. Sensitive words are replaced by a grey felt tip pen line of fixed length. Nothing else is altered.
Code:
Sub Redact() ' ' Redact Macro ' Redacts any words listed in sWordListDoc (see right after Application.ScreenUpdating = False ) ' from the currently open .dotx file by replacing those words by a 'grey felt tip pen' mark ' Once run check and save. Future readers cannot get to the original text or see its length. Dim sWordListDoc As String Dim docRef As Document Dim docCurrent As Document Dim wrdRef As Object Application.ScreenUpdating = False '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' sWordListDoc = "C:\Users\..........WordList.dotx" 'edit this to the location of your WordList.dotx or whatever you have called it. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Set docCurrent = Selection.Document Set docRef = Documents.Open(sCheckDoc) docCurrent.Activate With Selection.Find .ClearFormatting .Replacement.ClearFormatting With .Replacement.Font .Italic = True .ColorIndex = wdGray25 'pale grey .Size = 10 .Name = "Webdings" End With .Replacement.Text = "gggg" ' = 4 squares in Webdings font .Forward = True .Format = True .MatchWholeWord = True .MatchCase = True .MatchWildcards = False End With For Each wrdRef In docRef.Words If Asc(Left(wrdRef, 1)) > 32 Then With Selection.Find .Wrap = wdFindContinue .Text = wrdRef .Execute Replace:=wdReplaceAll End With End If Next wrdRef Application.ScreenUpdating = True docRef.Close docCurrent.Activate End Sub |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Find several words in document, copy paragraph and create new document | coolio2341 | Word VBA | 6 | 01-31-2019 01:17 PM |
styles in current document | otuatail | Word | 15 | 03-22-2018 09:25 AM |
Custom dictionary to highlight words listed therein only? | szachraj | Word | 2 | 01-10-2016 05:43 PM |
OLE refering to current document | Faire | Word | 8 | 08-25-2014 09:46 PM |
Lock words in a document, but allow for input within the document | tlinde | Word | 1 | 02-09-2010 09:07 PM |