anonymous No title
No License VBA
2021年04月11日
Copy Clone
Option Explicit

Enum FileCompareResult
    一致 = 0
    不一致 = 1
    エラー = 2
End Enum

Sub ファイル比較(fileA As String, fileB As String)
    
    Dim Result As FileCompareResult
    Result = fileCompare(fileA, fileB)
    
    Select Case Result
    Case FileCompareResult.一致
        MsgBox "ファイルは一致しています。", vbInformation + vbOKOnly
    Case FileCompareResult.不一致
        MsgBox "ファイルは一致していません。", vbInformation + vbOKOnly
    Case FileCompareResult.エラー
        MsgBox "比較中にエラーが発生しました。(ファイルが存在していないなど)", vbCritical + vbOKOnly
    End Select
    
End Sub

Function fileCompare(fileA_FullPath As String, fileB_FullPath As String) As FileCompareResult

    '★WSH実行のベースはOffice TANAKAさん
    'MS-DOSコマンドの標準出力を取得する
    'http://officetanaka.net/excel/vba/tips/tips27.htm

    Dim WSH, wExec, sCmd As String
    Set WSH = CreateObject("WScript.Shell")
    
    'コマンド実行 comp /M …ファイルの比較、/Mは次ファイルの対話的確認を省略
    sCmd = "comp /M """ & fileA_FullPath & """ """ & fileB_FullPath & """"
    Set wExec = WSH.Exec("%ComSpec% /c " & sCmd)
    
    '実行完了待機
    Do While wExec.Status = 0
        DoEvents
    Loop
    
    '実行時標準出力取得
    Dim ResultStdOut As String
    ResultStdOut = wExec.StdOut.ReadAll
    
    '結果判定
    If ResultStdOut Like "*ファイルに違いはありません*" Then
        fileCompare = FileCompareResult.一致
    ElseIf ResultStdOut Like "*ファイルのサイズが違います*" _
            Or ResultStdOut Like "*比較エラーがあります*" Then
        fileCompare = FileCompareResult.不一致
    Else
        fileCompare = FileCompareResult.エラー
    End If
        
    Set wExec = Nothing
    Set WSH = Nothing
    
    
    '★想定しているcompコマンドの結果
    '>comp /M "C:\temp\fileCompare\AkihabaraKousaten.jpg" "C:\temp\fileCompare\AkihabaraKousaten.jpg"
    'C:\temp\fileCompare\AkihabaraKousaten.jpg と C:\temp\fileCompare\AkihabaraKousaten.jpg を比較しています...
    'ファイルに違いはありません
    '>echo %ERRORLEVEL%
    '0
    '
    '>comp /M "C:\temp\fileCompare\JrOchanomizuEki.jpg" "C:\temp\fileCompare\AkihabaraKousaten.jpg"
    'C:\temp\fileCompare\JrOchanomizuEki.jpg と C:\temp\fileCompare\AkihabaraKousaten.jpg を比較しています...
    'ファイルのサイズが違います。
    '>echo %ERRORLEVEL%
    '1
    '
    '>comp /M "C:\temp\fileCompare\JrOchanomizuEki.jpg" "C:\temp\fileCompare\JrOchanomizuEki_binarryMod.jpg"
    'C:\temp\fileCompare\JrOchanomizuEki.jpg と C:\temp\fileCompare\JrOchanomizuEki_binarryMod.jpg を比較しています...
    'OFFSET 2000 で比較エラーがあります
    'ファイル1 = 32
    'ファイル2 = 23
    '
    '>echo %ERRORLEVEL%
    '1
    '
    '>comp /M "C:\temp\fileCompare\AkihabaraKousaten.jpg" "C:\temp\fileCompare\AkihabaraKousaten.jp"
    'C:\temp\fileCompare\AkihabaraKousaten.jpg と C:\temp\fileCompare\AkihabaraKousaten.jp を比較しています...
    'ファイルが見つからないか、開けません: C:\temp\fileCompare\AkihabaraKousaten.jp
    '
    '>echo %ERRORLEVEL%
    '2

End Function
Option Explicit

Enum FileCompareResult
    一致 = 0
    不一致 = 1
    エラー = 2
End Enum

Sub ファイル比較(fileA As String, fileB As String)
    
    Dim Result As FileCompareResult
    Result = fileCompare(fileA, fileB)
    
    Select Case Result
    Case FileCompareResult.一致
        MsgBox "ファイルは一致しています。", vbInformation + vbOKOnly
    Case FileCompareResult.不一致
        MsgBox "ファイルは一致していません。", vbInformation + vbOKOnly
    Case FileCompareResult.エラー
        MsgBox "比較中にエラーが発生しました。(ファイルが存在していないなど)", vbCritical + vbOKOnly
    End Select
    
End Sub

Function fileCompare(fileA_FullPath As String, fileB_FullPath As String) As FileCompareResult

    '★WSH実行のベースはOffice TANAKAさん
    'MS-DOSコマンドの標準出力を取得する
    'http://officetanaka.net/excel/vba/tips/tips27.htm

    Dim WSH, wExec, sCmd As String
    Set WSH = CreateObject("WScript.Shell")
    
    'コマンド実行 comp /M …ファイルの比較、/Mは次ファイルの対話的確認を省略
    sCmd = "comp /M """ & fileA_FullPath & """ """ & fileB_FullPath & """"
    Set wExec = WSH.Exec("%ComSpec% /c " & sCmd)
    
    '実行完了待機
    Do While wExec.Status = 0
        DoEvents
    Loop
    
    '実行時標準出力取得
    Dim ResultStdOut As String
    ResultStdOut = wExec.StdOut.ReadAll
    
    '結果判定
    If ResultStdOut Like "*ファイルに違いはありません*" Then
        fileCompare = FileCompareResult.一致
    ElseIf ResultStdOut Like "*ファイルのサイズが違います*" _
            Or ResultStdOut Like "*比較エラーがあります*" Then
        fileCompare = FileCompareResult.不一致
    Else
        fileCompare = FileCompareResult.エラー
    End If
        
    Set wExec = Nothing
    Set WSH = Nothing
    
    
    '★想定しているcompコマンドの結果
    '>comp /M "C:\temp\fileCompare\AkihabaraKousaten.jpg" "C:\temp\fileCompare\AkihabaraKousaten.jpg"
    'C:\temp\fileCompare\AkihabaraKousaten.jpg と C:\temp\fileCompare\AkihabaraKousaten.jpg を比較しています...
    'ファイルに違いはありません
    '>echo %ERRORLEVEL%
    '0
    '
    '>comp /M "C:\temp\fileCompare\JrOchanomizuEki.jpg" "C:\temp\fileCompare\AkihabaraKousaten.jpg"
    'C:\temp\fileCompare\JrOchanomizuEki.jpg と C:\temp\fileCompare\AkihabaraKousaten.jpg を比較しています...
    'ファイルのサイズが違います。
    '>echo %ERRORLEVEL%
    '1
    '
    '>comp /M "C:\temp\fileCompare\JrOchanomizuEki.jpg" "C:\temp\fileCompare\JrOchanomizuEki_binarryMod.jpg"
    'C:\temp\fileCompare\JrOchanomizuEki.jpg と C:\temp\fileCompare\JrOchanomizuEki_binarryMod.jpg を比較しています...
    'OFFSET 2000 で比較エラーがあります
    'ファイル1 = 32
    'ファイル2 = 23
    '
    '>echo %ERRORLEVEL%
    '1
    '
    '>comp /M "C:\temp\fileCompare\AkihabaraKousaten.jpg" "C:\temp\fileCompare\AkihabaraKousaten.jp"
    'C:\temp\fileCompare\AkihabaraKousaten.jpg と C:\temp\fileCompare\AkihabaraKousaten.jp を比較しています...
    'ファイルが見つからないか、開けません: C:\temp\fileCompare\AkihabaraKousaten.jp
    '
    '>echo %ERRORLEVEL%
    '2

End Function
No one still commented. Please first comment.