CODEWITHSUNDEEP
vbams-wordfull-text-search
Dave F
Dave F

Reputation: 161

Word Macro - Log changes made by a find and replace

I have the below code that will search through a word document replacing any IDs it finds with a masked version of the number using RegEx (e.g. 412345678900 becomes 4123####8900). Each document could have multiple IDs in it. The IDs are sometimes scattered throughout the document text and not just in tables (so Excel is not an option).

I want to be able to write each of the replaced versions of the text found out to a log file with the file path and file name.

Sub Auto_Masking()

'Start at the very beginning. It's a very good place to start.
    Selection.HomeKey Unit:=wdStory

    With Selection.Find  ' Locate and mask the 12 digit IDs
        .Text = "<([4][0-9]{3})([0-9]{4})([0-9]{4})>"
        .Replacement.Text = "\1####\3"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'Put the user back at the beginning of the document
    Selection.HomeKey Unit:=wdStory
End Sub

How can I write/append each now masked number to a log file? I would like to have the log file show a list of all the IDs masked and the file they were in, so each line in the log file should look something like this:

filePath\fileName ; maskedID

with a line for each ID number masked (with one file potentially containing multiple IDs). e.g.:

c:\temp\test.docx;4123####8900
c:\temp\test.docx;4241####7629
c:\location\another.docx;4379####8478

I have a horrible feeling this is going to be impossible based on trying to get the value I want in the log file to display in a msgbox. After days of experimenting, I'm completely out of ideas.

I'm thinking a find and a find/replace may have to be used in a larger loop, one to do the replace, and one to find what was just replaced before moving on. Maybe based on Selection.Find.Found = True

Upvotes: 0

Views: 817

Answers (2)

Dave F
Dave F

Reputation: 161

Not 10 minutes after giving up, I worked it out.

The code to solve the issue and successfully complete the above task, with logging of each masked ID, is as follows:

Sub mask_card_numbers()
'
   Dim Counter As Long

' This next section prepares for log writing
    Dim Log1 As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' ForReading = 1, ForWriting = 2, ForAppending = 8
    Set LogIDs = fso.OpenTextFile("C:\LogDIR\IDs_Masked_with_Word.txt", 8, True)

' Get the filename and path for the log file
    FileName = ActiveDocument.Path & "\" & ActiveDocument.Name


' Mask IDs ####################################################
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
' The first pass collects a single digit from the text to search for which would artificially increase the counter so reduce it by one in advance
    Counter = Counter - 1 
    Do
        With Selection.Find
            .Text = "<([4][0-9]{3})([0-9]{4})([0-9]{4})>"
            .Replacement.Text = "\1xxxxxxxx\3"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True
            Counter = Counter + 1
        End With
' By keeping the selected text after the replacement, the masked
        FoundID = Selection.Text

' Write masked ID to a logfile
        If Len(FoundID) > 7 Then  ' Anything greater than 1 will probably work
            LogIDs.WriteLine FileName & ";" & FoundID 
        End If
        Selection.Find.Execute Replace:=wdReplaceOne
    Loop While Selection.Find.Found <> False

' Done Masking IDs ###########################################

End Sub

Upvotes: 1

joehanna
joehanna

Reputation: 1489

I really don't think you can do this with Word's Find & Replace if you want to intercept the values to log them to a file.

I suggest using the Find and iterating through them to manually mask the numbers and write them to a log file. I also tweaked your regex as it didn't work. The code below only works on one file at a time.

Sub Auto_Masking()

  Dim oDoc As Document
  Dim oSelection As Range
  Dim cc As String
  Dim bFound As Boolean


  Application.ScreenUpdating = False

  'Handle to the relevant document
  Set oDoc = ActiveDocument

  'Handle to the whole doc's text
  Set oSelection = oDoc.Content

  'Create your log file. Amend this to cope with Append if needed
  Open "C:\Temp\ChangeLog.txt" For Output As #1

  With oSelection.Find
    .Text = "<([4])([0-9]{15})>"  'NOTE: this will only work for Visa cards
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True

    bFound = True

    While bFound

      'Look for the next occurrence
      bFound = .Execute

      If bFound Then
        'Raw text
        cc = oSelection.Text

        'Manually scramble it
        oSelection.Text = Left(cc, 4) & "xxxx" & Right(cc, 4)

        Print #1, oDoc.FullName & ";" & oSelection.Text

        '*** Remove for Production ***
        'Show the result in the Immediate window whilst debugging.
        Debug.Print cc & " => " & oSelection.Text

      End If

    Wend

  End With

  'Close the log file
  Close #1

  'Be a good memory citizen
  Set oSelection = Nothing
  Set oDoc = Nothing

  Application.ScreenUpdating = False

End Sub

Upvotes: 0

Related Questions