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

时间:2015-07-17 02:58:08

标签: vba ms-word full-text-search

我有下面的代码,它将使用RegEx搜索word文档,用掩码版本的数字替换它找到的任何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 = "\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

如何将每个现在屏蔽的数字写入/追加到日志文件中?我想让日志文件显示所有屏蔽的ID列表以及它们所在的文件,因此日志文件中的每一行应如下所示:

filePath \ fileName; maskedID

屏蔽了每个ID号的一行(一个文件可能包含多个ID)。 e.g:

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

我有一种可怕的感觉,基于尝试在日志文件中获取我想要的值以显示在msgbox中,这是不可能的。经过几天的实验,我完全没有想法。

我正在考虑一个发现,并且可能必须在更大的循环中使用查找/替换,一个用于替换,一个用于在继续之前找到刚刚替换的内容。也许基于Selection.Find.Found = True

  • Selection.Find.Text将显示正则表达式
  • Selection.Text将仅显示ID号字符串的第一个字符,但不再显示
  • Selection.Find.Replacement.Text将显示With部分中显示的字符串,而不会将/ 1和/ 3替换为找到的值

2 个答案:

答案 0 :(得分:1)

放弃后不到10分钟,我就把它解决了。

解决问题并成功完成上述任务的代码,记录每个屏蔽ID,如下所示:

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

答案 1 :(得分:0)

我真的不认为你可以用Word的Find&amp; amp;如果要拦截值以将其记录到文件中,请替换。

我建议使用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