Microsoft Word 2010 VBA：使用正则表达式查找和替换答案

【问题标题】：Microsoft Word 2010 VBA: Using regex to find and replaceMicrosoft Word 2010 VBA：使用正则表达式查找和替换
【发布时间】：2015-06-04 02:56:20
【问题描述】：

我正在尝试让我们的员工快速屏蔽旧文档中信用卡数据的中间 8 位数字。我认为使用正则表达式进行查找和替换的宏是他们最快的方法。屏蔽是 PCI DSS 的要求，可能有成百上千的文档需要屏蔽其中的数据。

我对下面的代码有一些运气，但是它会识别和修改超出标准信用卡 16 个字符的字符串，我不知道如何阻止误报。由nhahtdh解决

以下标识存在上述问题的 Visa、MasterCard 和 AmEx 卡。但是，可以通过为更多卡片类型添加正则表达式并添加用于分解长数字的常用字符来改进它。

以下代码有效，但可以改进。任何人都可以通过以下方式帮助改善这一点：

包括 Luhn 算法检查
包括额外的常用数字分隔符（还有什么常用的？）
包括其他流行的卡片品牌
停止查找并替换误报（例如，应排除 44445555666677778）。由 nhahtdh 解决

    Sub PCI_mask_card_numbers()
'
' This macro will search a document for numbers that look like Visa, MasterCard and AmEx credit card PANs and mask them with Xs
'
   Dim Counter As Long
   Dim Preexisting As Long

' Let the user know what's about to happen
    Dim Msg, Style, Title, Response, MyString
    Msg = "The macro will now attempt to mask all the credit card numbers it can identify.  e.g. 4444555566667777 will become 4444xxxxxxxx7777"
    Style = vbInformation
    Title = "PCI DSS - Credit Card Masking"
    Response = MsgBox(Msg, Style, Title)

' Count how many things already look like masked PANs so the final tally is correct
    Selection.HomeKey Unit:=wdStory
    With ActiveDocument.Content.Find
        Do While .Execute(FindText:="xxxx", Forward:=True, Format:=True, _
           MatchWholeWord:=True) = True
           Preexisting = Preexisting + 1
        Loop
    End With
    Preexisting = Preexisting / 2   ' because masks with a break were counted twice
    Selection.HomeKey Unit:=wdStory
    With ActiveDocument.Content.Find
        Do While .Execute(FindText:="xxxxxxxx", Forward:=True, Format:=True, _
           MatchWholeWord:=False) = True
           Preexisting = Preexisting + 1
        Loop
    End With

' ########  Start masking PANs  ###################################################

' Mastercard - 16 digits straight
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "<([4][0-9]{3})([0-9]{4})([0-9]{4})([0-9]{4})>"
        .Replacement.Text = "\1xxxxxxxx\4"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

' Visa - 16 digits straight
    With Selection.Find
        .Text = "<([5][0-9]{3})([0-9]{4})([0-9]{4})([0-9]{4})>"
        .Replacement.Text = "\1xxxxxxxx\4"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

' AmEx - 15 digits straight
    With Selection.Find
        .Text = "<([3][0-9]{2})([0-9]{4})([0-9]{4})([0-9]{4})>"
        .Replacement.Text = "\1xxxxxxxx\4"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

' Visa and Mastercard - PAN broken up by :
    With Selection.Find
        .Text = "<([4][0-9]{3})(:[0-9]{4}:[0-9]{4}:)([0-9]{4})>"
        .Replacement.Text = "\1:xxxx:xxxx:\3"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "<([5][0-9]{3})(:[0-9]{4}:[0-9]{4}:)([0-9]{4})>"
        .Replacement.Text = "\1:xxxx:xxxx:\3"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

' Visa and Mastercard - PAN broken up by .
    With Selection.Find
        .Text = "<([5][0-9]{3})(.[0-9]{4}.[0-9]{4}.)([0-9]{4})>"
        .Replacement.Text = "\1.xxxx.xxxx.\3"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "<([4][0-9]{3})(.[0-9]{4}.[0-9]{4}.)([0-9]{4})>"
        .Replacement.Text = "\1.xxxx.xxxx.\3"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

' Visa and Mastercard - PAN broken up by spaces
    With Selection.Find
        .Text = "<([4][0-9]{3})( [0-9]{4} [0-9]{4} )([0-9]{4})>"
        .Replacement.Text = "\1 xxxx xxxx \3"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "<([5][0-9]{3})( [0-9]{4} [0-9]{4} )([0-9]{4})>"
        .Replacement.Text = "\1 xxxx xxxx \3"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

' Visa and Mastercard - PAN broken up by -
    With Selection.Find
        .Text = "<([5][0-9]{3})(-[0-9]{4}-[0-9]{4}-)([0-9]{4})>"
        .Replacement.Text = "\1-xxxx-xxxx-\3"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "<([4][0-9]{3})(-[0-9]{4}-[0-9]{4}-)([0-9]{4})>"
        .Replacement.Text = "\1-xxxx-xxxx-\3"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.HomeKey Unit:=wdStory

' ########  Done masking PANs  ###################################################

' Count how many changes were done
    Selection.HomeKey Unit:=wdStory
    With ActiveDocument.Content.Find
        Do While .Execute(FindText:="xxxx", Forward:=True, Format:=True, _
           MatchWholeWord:=True) = True
           Counter = Counter + 1
        Loop
    End With
    Counter = Counter / 2   ' because masks with a break were counted twice
    Selection.HomeKey Unit:=wdStory
    With ActiveDocument.Content.Find
        Do While .Execute(FindText:="xxxxxxxx", Forward:=True, Format:=True, _
           MatchWholeWord:=False) = True
           Counter = Counter + 1
        Loop
    End With
    Counter = Counter – Preexisting   ' New masks less previous mask-like data

' Let the user know the job is done
    Msg = "The macro has masked " & Str$(Counter) & " credit cards. Check the results and save the file if the changes are correct. If there are issues with the masking changes, do not save the file and consult the IT team."
    Style = vbInformation
    Title = "PCI DSS - Credit Card Masking." & Str$(Counter) & " cards masked"
    Response = MsgBox(Msg, Style, Title)
End Sub

【问题讨论】：

也许添加逻辑以使用 Luhn 算法检查匹配，以确保其验证为 CC 编号？
这是个好主意，丹。可悲的是，我不知道如何在 Word 宏中实现它。
gist.github.com/cimnine/7913819

标签： regex vba replace ms-word pci-compliance

【解决方案1】：

由于您似乎使用的是 Word 通配符语法，您可能可以使用<，它断言单词的开头，和>，它断言单词的结尾，以防止在文本前面时模式匹配或者后面是字母或数字（从一些简单的测试来看，这似乎是如何工作的）。

使用

"([4][0-9]{3})(-[0-9]{4}-[0-9]{4}-)([0-9]{4})"

例如，修改成

"<([4][0-9]{3})(-[0-9]{4}-[0-9]{4}-)([0-9]{4})>"

【讨论】：