Microsoft Word 2010 VBA：使用正则表达式查找和替换
Microsoft Word 2010 VBA: Using regex to find and replace
我正在尝试让我们的员工快速屏蔽旧文档中信用卡数据的中间 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 = "xxxxxxxx"
.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 = "xxxxxxxx"
.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 = "xxxxxxxx"
.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 = ":xxxx:xxxx:"
.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 = ":xxxx:xxxx:"
.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 = ".xxxx.xxxx."
.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 = ".xxxx.xxxx."
.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 = " xxxx xxxx "
.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 = " xxxx xxxx "
.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 = "-xxxx-xxxx-"
.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 = "-xxxx-xxxx-"
.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
因为您似乎在使用 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})>"
我正在尝试让我们的员工快速屏蔽旧文档中信用卡数据的中间 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 = "xxxxxxxx"
.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 = "xxxxxxxx"
.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 = "xxxxxxxx"
.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 = ":xxxx:xxxx:"
.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 = ":xxxx:xxxx:"
.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 = ".xxxx.xxxx."
.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 = ".xxxx.xxxx."
.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 = " xxxx xxxx "
.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 = " xxxx xxxx "
.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 = "-xxxx-xxxx-"
.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 = "-xxxx-xxxx-"
.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
因为您似乎在使用 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})>"