マイナンバーチェックを実現するマクロ

ExcelなどにあるMicrosoftのマクロは、マルウェアに感染する危険があるということで、情報セキュリティの界隈では、あまり使うことが推奨されてません。

しかし、これは変な話しです。

そもそもマクロはプログラム（VBA）で動くアプリケーションであり、それが危険というのは、アプリは危険というのと同じです。まあ、確かに危険かもしれませんが、過剰な拒否反応する必要は無いと思います。

また、マクロは事務処理の効率化を促進する便利なツールですが、単に効率化するだけなく、情報セキュリティインシデントを防ぐための活用にも使えます。

その一例として、「マイナンバー」のチェックが考えられます。

従業員から提出を受けるマイナンバーは「特定個人情報」です。法律で定められた項目以外の目的でマイナンバーを収集・保管することは認められてなく、姓名や住所といった個人情報よりもさらに厳密な管理が必要です。

マイナンバーは人手での入力間違いが発生しても機械的にすぐわかるように、チェックデジットと呼ばれる1桁が付け加えられてます。マイナンバー法では「検査用数字」と言います。個人番号の検査用数字は一番右側の1桁で、その計算式は総務省令第八十五号（行政手続における特定の個人を識別するための番号の利用等に関する法律に規定する個人番号、個人番号カード、特定個人情報の提供等に関する命令）の第五条で次のように定められてます。

算式

ただし、を11で除した余り≦1の場合は、0とする。

算式の符号

P_n　個人番号を構成する検査用数字以外の十一桁の番号の最下位の桁を１桁目としたときのｎ桁目の数字　
Ｑ_n　１≦ｎ≦６のときｎ＋１７≦ｎ≦１１のときｎ－５

マイナンバーは法で定めた明確な計算ルールがあるので、VBAでたとえば Wordで記載された文書のなかに、マイナンバーの番号体系が含まれているかを確認することができます。紙媒体だと目での確認となるので、チェック漏れが起きやすく、結果的に「情報セキュリティインシデント」につながりやすいのですが、電子媒体に記録されていれば、チェックはかなり楽になります。

下記のサンプルマクロは、Excelから実行することで、取り込んだ、Wordの文書に「マイナンバー」の番号体系が存在するかをチェックします。

マイナンバー体系に沿った番号がなければ

のメッセージを表示し、存在すれば

を表示するように書いてます。

Option Explicit
Sub CheckWordForMyNumber()
Dim wdApp As Object, wdDoc As Object
Dim filePath As String
Dim fileText As String
Dim re As Object, matches As Object, m As Object
Dim digitsOnly As String

' --- Wordファイルを指定 ---
filePath = Application.GetOpenFilename("Wordファイル (*.docx),*.docx", , "Wordファイルを選んでください")
If filePath = "False" Then Exit Sub

' --- Word起動してファイルを開く ---
Set wdApp = CreateObject("Word.Application")
Set wdDoc = wdApp.Documents.Open(filePath, ReadOnly:=True)

' --- 全文テキストを取得 ---
fileText = wdDoc.Content.Text

' --- 正規表現で候補を探す ---
Set re = CreateObject("VBScript.RegExp")
re.Pattern = "[\d\-\s]{12,20}"
re.Global = True
re.IgnoreCase = True

Set matches = re.Execute(fileText)

For Each m In matches
digitsOnly = KeepDigits(m.Value)
If Len(digitsOnly) = 12 Then
MsgBox "マイナンバーが含まれていますので、取扱いに注意してください", vbExclamation
GoTo EndCheck
End If
Next m

MsgBox "マイナンバーは検出されませんでした", vbInformation
EndCheck:
wdDoc.Close False
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
End Sub
Private Function KeepDigits(s As String) As String
Dim i As Long, ch As String, outS As String
outS = ""
For i = 1 To Len(s)
ch = Mid$(s, i, 1)
If ch >= "0" And ch <= "9" Then outS = outS & ch
Next i
KeepDigits = outS
End Function