旧字体と新字体の違いをいい感じに吸収して検索する方法が知りたい

きっかけ

Excelで作った名簿があって、そこにはメールアドレスが載っていなかったので、
アドレス帳からメールアドレスを取得するExcelマクロを作ったときに
だいたいは上手く取れたのだけど、
旧字体と新字体の違いで上手く取得できないことがあって、
（字体以外に、単なる誤入力とかもあったりしたけど）

一文字くらいの違いなら「もしかしてこれ？」と聞いてこい！という思想で
間に合わせで以下のような「なんちゃってあいまい検索」にしたが
本当はもっとスマートで正しい方法が、きっとあるのだろうなあ

コード

Function aimai(strText)
    ReDim strPattern(Len(strText))
    Dim i
    For i = 0 To UBound(strPattern)
        strPattern(i) = strText
        If i > 0 Then Mid(strPattern(i), i) = "."
    Next
    aimai = Join(strPattern, "|")
End Function

Sub sample()
    With CreateObject("VBScript.RegExp")
        .Pattern = aimai("髙田三郎")
               '  "髙田三郎|.田三郎|髙.三郎|髙田.郎|髙田三."

    '以下略