Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 10-31-2019, 03:00 AM
AlanofBayCourt AlanofBayCourt is offline How to redact words listed in one document from the current document Windows 10 How to redact words listed in one document from the current document Office 2016
Novice
How to redact words listed in one document from the current document
 
Join Date: Oct 2019
Posts: 1
AlanofBayCourt is on a distinguished road
Default 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
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
How to redact words listed in one document from the current document 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
How to redact words listed in one document from the current document 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

Other Forums: Access Forums

All times are GMT -7. The time now is 11:18 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