はじめに

最近ですが大規模基幹システムのリプレイスを任される機会がありました。
その際に、各サーバに配置されている現行システム設定ファイルの環境差分を確認しなければいけませんでした。
手作業だと確認作業に莫大な時間がかかるため、ファルダ指定でファイル一覧出力と ファイルのハッシュ値を一発出力できるマクロを作りました。その際の備忘録を残したいと思います。

本マクロを応用すれば、出力したハッシュ値からファイル内容の差分有無を色付け区別したりも出来ますね。

やりたいこと

• フォルダ指定で再帰的にファイル一覧を作成
• 対象ファイルのハッシュ値を確認
• 結果をエクセルに出力

ファイル一覧取得方法

指定フォルダ配下のファイル一覧を再帰的に取得するには、下記コマンドで一発です。
このコマンドをExcelのマクロからフォルダを指定して実行します。

フォルダを除いたファイルの絶対パスのみを再帰的に取得

dir /b /s /a-d  

ハッシュ値 確認方法

ファイルのハッシュ値はコマンドプロンプトで certutil を実行することで取得できます。
hashfile オプションの後ろに対象ファイルの絶対パスを設定します。
デフォルトのアルゴリズムはMD5ですが、引数で指定することも出来ます。

コマンド例

certutil -hashfile C:\Users\atsu\Desktop\test.txt

出力結果

MD5 ハッシュ (対象 C:\Users\atsu\Desktop\test.txt):
080aa7e73febb99d4f4f6eaca26b4766
CertUtil: -hashfile コマンドは正常に完了しました。

ハッシュ値のみ取り出す場合

certutil -hashfile C:\Users\atsu\Desktop\test.txt MD5 | findstr /V CertUtil | findstr /V " & MD5  

出力結果

080aa7e73febb99d4f4f6eaca26b4766

VBAマクロからコマンドプロンプトを実行

先ほど紹介したファイルリスト取得コマンド、ファイルのハッシュ値取得コマンドを VBAマクロからコマンドプロンプトを操作して実行します。その方法は過去の記事で紹介しているのでご確認下さい。
【Excel VBA】VBAマクロからコマンドプロンプトを操作するTips

成果物のイメージ

入力シート

シート名は【実行対象リスト】で、C列にファイルリストとハッシュ値を出力したいファイルが入ったフォルダの絶対パスを指定します。

出力シート

シート名は【■出力_ファイル一覧】で、絶対パス、ファルダ、ファイル名、ハッシュ値を出力します。

実行プロシージャ

'ファイル一覧出力
Sub makeFileList()

    Dim command As String
    Dim StRow As Integer
    StRow = 2
    Dim EdRow As Integer
    EdRow = Sheets("実行対象リスト").Cells(1, 1).End(xlDown).Row
    Dim LRow As Integer
    LRow = 1
    Dim FilePathSr As Sr
    'コンテンツクリア
    
    'ファイルリスト出力
    For i = StRow To EdRow
        If Sheets("実行対象リスト").Cells(i, 2) = "〇" Then
            Path = Sheets("実行対象リスト").Cells(i, 3)
            command = "dir /b /s /a-d" & " " & Path
            modConsole.executeCmdSetSr FilePathSr, command
            For j = LRow To UBound(FilePathSr.Item)
                Sheets("■出力_ファイル一覧").Cells(j + 1, 1).Value = FilePathSr.Item(j)
                Sheets("■出力_ファイル一覧").Cells(j + 1, 2).Value = modUtil.GetFolderFromPath(FilePathSr.Item(j))
                Sheets("■出力_ファイル一覧").Cells(j + 1, 3).Value = modUtil.GetFileNameFromPath(FilePathSr.Item(j))
            Next
            LRow = Sheets("■出力_ファイル一覧").Cells(1, 1).End(xlDown).Row
        End If
    Next
    
    EdRow = Sheets("■出力_ファイル一覧").Cells(1, 1).End(xlDown).Row
    'ハッシュ値出力
    If Sheets("実行対象リスト").Range("F2") = "〇" Then
        Dim hashCmdSr As Sr
        Dim FileSize
        Dim OutFilePath
        OutFilePath = ThisWorkbook.Path & "\out.txt"
        For i = StRow To EdRow
            filePath = Sheets("■出力_ファイル一覧").Cells(i, 1).Value
            'ファイルサイズ判定
            'ファイルサイズが0の場合、certutil コマンドの返り値がないため
            FileSize = FileLen(filePath)
            If FileSize = 0 Then
                command = "echo filesizeZero >> " & OutFilePath
            Else
                command = "certutil -hashfile " & filePath & " MD5 | findstr /V CertUtil | findstr /V MD5 >> " & OutFilePath
            End If
            modUtil.Add hashCmdSr, command
        Next
        'バッチファイル作成
        Dim BatFilePath
        BatFilePath = ThisWorkbook.Path & "\hashExecute.bat"
        modFile.WriteFile BatFilePath, hashCmdSr
        'バッチファイル実行
        modConsole.executeBat (BatFilePath)
        '結果取得
        Dim ResultSr As Sr
        modFile.SetSrFromFile ResultSr, OutFilePath
        '結果出力
        For i = StRow To EdRow
            Sheets("■出力_ファイル一覧").Cells(i, 4).Value = ResultSr.Item(i - 1)
        Next
        Kill BatFilePath
    End If
    MsgBox ("end")
    
End Sub

その他 標準モジュール

modConsole

'コンソール実行(文字列返却)
Public Function executeCommand(command As String)
    Dim sh As New IWshRuntimeLibrary.WshShell
    Dim ex As WshExec
    Set ex = sh.Exec(makeCommand(command))
    If (ex.Status = WshFailed) Then
        Exit Function
    End If
    Do While (ex.Status = WshRunning)
        DoEvents
    Loop
    Dim result
    result = ex.StdOut.ReadAll
    executeCommand = result
End Function
'コンソール実行(配列に結果格納)
Public Sub executeCmdSetSr(Sr As Sr, command As String)
    Dim Path
    Path = ThisWorkbook.Path & "out.txt"
    Dim wsh As New IWshRuntimeLibrary.WshShell
    wsh.Run makeCommand(command & " > " & Path), 0, True
    Set wsh = Nothing
    modFile.SetSrFromFile Sr, Path
End Sub
'バッチファイル実行
Public Sub executeBat(Path)
    Dim wsh As New IWshRuntimeLibrary.WshShell
    wsh.Run Path, 0, True
    Set wsh = Nothing
End Sub
'コマンド作成
Public Function makeCommand(command As String)
    makeCommand = "%ComSpec% /c " & command
End Function

modFile

'ファイル読み込み文字列リスト設定
Public Sub SetSrFromFile(Sr As Sr, Path)
    'ファイル存在確認未実装
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim txtStream
    Set txtStream = FSO.OpenTextFile(Path)
    Dim Data
    With txtStream
        Data = .ReadAll
        .Close
    End With
    tmp = Split(Data, vbLf)
    For i = 0 To UBound(tmp)
        Dim Line
        Line = Replace(tmp(i), vbCr, "")
        Line = Replace(Line, vbLf, "")
        Line = Trim(Line)
        If Line <> "" Then
            modUtil.Add Sr, Line
        End If
    Next
    Kill Path
End Sub
'batファイル作成
Public Sub WriteFile(Path, Sr As Sr)
    Open Path For Append As #1
    Print #1, Join(Sr.Item, vbCrLf)
    Close #1
End Sub

modUtil

'配列定義
Public Type Sr
    Item() As String
    count As Integer
End Type
'配列追加メソッド(配列自動拡張型)
Public Sub Add(Sr As Sr, str)
    With Sr
        .count = .count + 1
        ReDim Preserve .Item(.count)
        .Item(.count) = str
    End With
End Sub
'配列初期化
Public Sub Clr(Sr As Sr)
    With Sr
        Erace .Item
        count = 0
    End With
End Sub
'改行文字列配列化
Public Function ConvNlStrToArray(str As String)
    ConvNlStrToArray = Split(str, vbCrLf)
End Function
'ファイル名返却
Public Function GetFileNameFromPath(Path)
    GetFileNameFromPath = Mid(Path, InStrRev(Path, "\") + 1)
End Function
'フォルダパス返却
Public Function GetFolderFromPath(Path)
    GetFolderFromPath = Left(Path, InStrRev(Path, "\") - 1)
End Function