Word Macro - Log changes made by a find and replace - vba

Question

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
Selection.Find.Text will display the regex
Selection.Text will display only the first character of the ID number string, but no more
Selection.Find.Replacement.Text will display the string as it appears in the With section, without replacing the /1 and /3 with the values it found

Answer 1

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

Answer 2

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