不要な名前定義を検索し削除するマクロ

あまり知られてない(？)けど、エクセルを作成したときに意図せず名前定義が設定されることがある。
名前定義にはローカルパスや共有ファイルを触っている場合には共有フォルダのURL(IPアドレス含む)が設定されてしまうことがある。

もしテンプレートをコピーして使用していた場合に、見せたくないパスやIPアドレスが混入してしまう。

そこで、不要と思われる名前定義を一括削除するマクロを作ってみた。
※私はvba門外漢のため取り敢えず動けばOKとした。

vbaでファイルを扱うクラスは複数あるようだが、一番直感的に理解できたFileSystemObjectを使った。
FileSystemObjectはExcel2007くらいからしか使えない？らしいので気をつけて。
■仕様説明
指定されたディレクトリ内(サブディレクトリ含む)のエクセルファイルを検索し、名前定義から"\"，"Doc"，"#REF"に部分一致する名前定義を削除します。
削除された名前定義はテキストファイル：[指定したディレクトリ]\DeleteNames.txt
※"\"は\\10.XX.XX.XXXなどのIPアドレスを意識，"Doc"はDocument and Settingを意識，"#REF"は読めないデータは必要ないということで。

実行するとヒットしたエクセルを一つずつ開いては閉じー、開いては閉じーするのでスペック低いPCだと処理時間がかかると思われる。
できればそこそこスペックの良いPCで実行すると幸せだろうと思う。

Private Const cnsFILENAME = "\DeleteNames.txt"

Sub DeleteNames()
    
    Dim dirStr As String
    dirStr = InputBox("フォルダを指定", "FolderPath", "")
    
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim TextFile As Object
    Set TextFile = FSO.CreateTextFile(dirStr & cnsFILENAME)
    
    Call FileSearch(dirStr, TextFile, FSO)
    
    TextFile.Close
    Set TextFile = Nothing
    Set FSO = Nothing
End Sub

Sub FileSearch(Path As String, TextFile As Object, FSO As Object)
    Dim Folder As Variant, File As Variant
    Dim book As Workbook
    Dim name As Object
    Dim delFlg As Boolean, readOnlyFlg As Boolean, printFlg As Boolean
    Dim readAttr As Long
    
    For Each Folder In FSO.GetFolder(Path).SubFolders
        Call FileSearch(Folder.Path, TextFile, FSO)
    Next Folder
    For Each File In FSO.GetFolder(Path).Files
    
        readAttr = GetAttr(File.Path)
        If readAttr And vbReadOnly Then
            SetAttr File.Path, vbNormal
            readOnlyFlg = True
        End If
    
        delFlg = False
        printFlg = True
        If InStr(File.Type, "Excel") > 0 Then
            
            Workbooks.Open File.Path
            Set book1 = Workbooks(File.name)
            
            For Each name In book1.Names
                If InStr(name, "\") > 0 Then
                    If printFlg = True Then
                        TextFile.WriteLine File.Path
                    End If
                    TextFile.WriteLine "   " + name.name + " " + name
                    
                    name.Delete
                    delFlg = True
                    printFlg = False
                ElseIf InStr(name, "Doc") > 0 Then
                    If printFlg = True Then
                        TextFile.WriteLine File.Path
                    End If
                    TextFile.WriteLine "   " + name.name + " " + name
                    
                    name.Delete
                    delFlg = True
                    printFlg = False
                ElseIf InStr(name, "#REF") > 0 Then
                    If printFlg = True Then
                        TextFile.WriteLine File.Path
                    End If
                    TextFile.WriteLine "   " + name.name + " " + name
                    
                    name.Delete
                    delFlg = True
                    printFlg = False
                Else
                    'nop
                End If
            Next
            
            Application.DisplayAlerts = False
            If delFlg = True Then
                book1.Save
            End If
            book1.Close
            Application.DisplayAlerts = True
            
            If readOnlyFlg = True Then
                 SetAttr File.Path, vbReadOnly
            End If
            Set book1 = Nothing
        End If
    Next File
End Sub

■説明
DeleteNamesがMainメソッドみたいなモノ。
ログファイルを吐くためにTextFileオブジェクトを保持する。
FSO(File System Object)を使い回しているのは、FileSearchメソッドは再帰的に処理されるためサブディレクトリを走査する際にNULLになったりして面倒だったから。

○FileSearchの説明
・GetAttr(File.Path)あたりは読み込み専用ファイルを一時的に書き込みできるよう変更している。
※ちゃんとフラグ持ってあとで読み込み専用に戻したりもしている。
※2 あれ？もしかしてフラグ初期化されてない？面倒なので使う人考えて頂戴
・For Each name In book1.Names
book1.Namesで名前定義のListが取得できる。
こいつを一つずつ見ていって、部分一致したら削除(name.Delete)する。
・Application.DisplayAlerts = False
Excelから「保存しますか？」や「互換性がうんぬん」言われるのが嫌だったからいろいろググってやってみた。
ほとんどうまくいっていたと思う。

もっと綺麗にかけると思う(検索キーを配列で持つとか)けど、動いて、結果も十分だったのでこれでよしとした。