Word 宏 - 记录由查找和替换所做的更改

Question

我有下面的代码，它将搜索一个 word 文档，使用 RegEx 将它找到的任何 ID 替换为数字的掩码版本（例如 412345678900 变成 4123####8900）。每个文档中可以有多个 ID。 ID 有时分散在整个文档文本中，而不仅仅是在表格中（因此 Excel 不是一个选项）。

我希望能够将找到的文本的每个替换版本写入包含文件路径和文件名的日志文件。

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 = "####"
        .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

我怎样才能write/append将每个现在屏蔽的号码记录到日志文件中？我想让日志文件显示所有被屏蔽的 ID 及其所在文件的列表，因此日志文件中的每一行都应如下所示：

filePath\fileName;掩码 ID

每个 ID 号都有一行被屏蔽（一个文件可能包含多个 ID）。例如：

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

我有一种可怕的感觉，这将是不可能的，因为我试图在日志文件中获取我想要的值以显示在 msgbox 中。经过几天的试验，我完全没有想法。

我在想一个 find 和一个 find/replace 可能必须在更大的循环中使用，一个用于替换，一个用于在继续之前找到刚刚替换的内容。也许基于 Selection.Find.Found = True

Selection.Find.Text 将显示正则表达式
Selection.Text将只显示身份证号码字符串的第一个字符，不再显示
Selection.Find.Replacement.Text 将显示在 With 部分中出现的字符串，而不用它找到的值替换 /1 和 /3

Answer 1

如果您想拦截值以将它们记录到文件中，我真的不认为您可以使用 Word 的查找和替换来执行此操作。

我建议使用 Find 并遍历它们以手动屏蔽数字并将它们写入日志文件。我还调整了你的 regex，因为它不起作用。下面的代码一次只能处理一个文件。

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

Answer 2

放弃后不到10分钟，我就解决了。

解决问题并成功完成上述任务的代码如下：

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 = "xxxxxxxx"
            .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

Word 宏 - 记录由查找和替换所做的更改

Word Macro - Log changes made by a find and replace

vba

full-text-search

ms-word