ファイルDIFF


```ruby:全体処理(ルートフォルダを指定して探索を開始)

Option Explicit

Const SheetName As String = "ファイルチェック"
Private g_cntFILE As Long
Private g_cntPATH As Long
'*******************************************************************************
'   全体処理(ルートフォルダを指定して探索を開始)
'*******************************************************************************
Private Sub CommandButton1_Click()
    Dim objFSO As FileSystemObject
    Dim strPathName As String
    Dim wk As Object
    Dim chkSheetsNm As Boolean
    Dim eline As Long
    Dim sline As Long
    Dim fname As String
    Dim searchFolder As String
    Dim chkSrcText As String
    Dim chkDstText As String

    On Error GoTo ERR_チェック_Click


    ' ルートとなるフォルダの指定(※modAPIBrowseForFolder2.bas)
'    strPATHNAME = modAPIBrowseForFolder2.BrowseForFolder( _
'        "ルートフォルダを指定して下さい。", True)
'    If strPATHNAME = "" Then Exit Sub

    chkSrcText = ThisWorkbook.Sheets(SheetName).Range("C3").Value
    chkDstText = ThisWorkbook.Sheets(SheetName).Range("C5").Value
    ' ファイルチェックシートが無ければ作成します｡ (存在すればシート内をクリア)
    Call sheetChkMake(SheetName)

    'ズームの設定を75%にします。
    ActiveWindow.Zoom = 75
    ThisWorkbook.Sheets(SheetName).Range("B3").Value = "チェック元フォルダ"
    ThisWorkbook.Sheets(SheetName).Range("B5").Value = "チェック先フォルダ"
    ThisWorkbook.Sheets(SheetName).Range("B8").Value = "チェック元"
    ThisWorkbook.Sheets(SheetName).Range("B9").Value = "フォルダ"
    ThisWorkbook.Sheets(SheetName).Range("C9").Value = "ファイル"
    ThisWorkbook.Sheets(SheetName).Range("B9:C9").Select
    With Selection
        .ColumnWidth = 30
    End With
    ThisWorkbook.Sheets(SheetName).Range("D9").Value = "日付"
    ThisWorkbook.Sheets(SheetName).Range("E9").Value = "最終更新日"
    ThisWorkbook.Sheets(SheetName).Range("F9").Value = "サイズ(byte)"
    ThisWorkbook.Sheets(SheetName).Range("D9:F9").Select
    With Selection
        .ColumnWidth = 10
    End With
    ThisWorkbook.Sheets(SheetName).Range("G8").Value = "チェック先"
    ThisWorkbook.Sheets(SheetName).Range("G9").Value = "フォルダ"
    ThisWorkbook.Sheets(SheetName).Range("H9").Value = "ファイル"
    ThisWorkbook.Sheets(SheetName).Range("G9:H9").Select
    With Selection
        .ColumnWidth = 30
    End With
    ThisWorkbook.Sheets(SheetName).Range("I9").Value = "日付"
    ThisWorkbook.Sheets(SheetName).Range("J9").Value = "最終更新日"
    ThisWorkbook.Sheets(SheetName).Range("K9").Value = "サイズ(byte)"
    ThisWorkbook.Sheets(SheetName).Range("I9:K9").Select
    With Selection
        .ColumnWidth = 10
    End With
    
    ThisWorkbook.Sheets(SheetName).Range("C3").Value = chkSrcText
    strPathName = ThisWorkbook.Sheets(SheetName).Range("C3")
    ThisWorkbook.Sheets(SheetName).Range("C5").Value = chkDstText
    
    ' 処理開始
'    Cells.ClearContents
    Set objFSO = New FileSystemObject           ' FSO
    ' チェック元フォルダ（サブフォルダ含む）を検索し、表示します。
    Call SEARCH_SUB_FOLDER(strPathName, objFSO.getFolder(strPathName), 10, 0)
    ' 参照OBJECTを破棄
    Set objFSO = Nothing


    '最終行を取得します。
    eline = ThisWorkbook.Sheets(SheetName).Range("C65536").End(xlUp).Row
    
    '金利系ファイルのアップを行います。
    For sline = 10 To eline
        'ファイル名を取得します。
        fname = ThisWorkbook.Sheets(SheetName).Range("C" & sline)
        searchFolder = ThisWorkbook.Sheets(SheetName).Range("C5")
'        If serachFileInf(Fname, searchFolder, sline) = False Then
'            Exit Sub
'        End If
'        If FileSearchInf(Fname, searchFolder, sline) = False Then
'            Exit Sub
'        End If
        Call FileSearch(fname, searchFolder, sline)
    Next
    
    ' 処理完了(結果表示)
    MsgBox "処理が完了しました。" & vbCr & vbCr & _
        "フォルダ数=" & g_cntPATH & vbCr & _
        "ファイル数=" & g_cntFILE, vbInformation

Exit_チェック_Click:
    Exit Sub

ERR_チェック_Click:
    MsgBox Err.Description
End Sub

'/*******************************************************************
'/* 引数で渡されたシート名をチェックし、存在しない場合は作成します。
'/*******************************************************************
Public Sub sheetChkMake(SheetName As String)
Dim wk As Object
Dim chkSheetsNm As Boolean

    chkSheetsNm = False
    
    For Each wk In Sheets
        If LCase(SheetName) = LCase(wk.Name) Then
            chkSheetsNm = True
            Exit For
        End If
    Next

    'ファイルチェックシートが存在しない場合は新規に作成します。
    If chkSheetsNm = False Then
        Worksheets.Add
        ActiveSheet.Name = SheetName
    Else
        Worksheets(SheetName).Activate
    End If

    ActiveSheet.Cells.Clear
End Sub

'*******************************************************************************
'   フォルダ単位のサブ処理(再帰動作,引数はFile-Object,行,カラム)
'*******************************************************************************
Private Sub SEARCH_SUB_FOLDER(strPathName As String, _
                              ByVal objPATH As Folder, _
                              ByRef GYO As Long, _
                              ByVal col As Long)
On Error GoTo ERR_SEARCH_SUB_FOLDER

    Dim objPATH2 As Folder
    Dim objFILE As File

    ' 現在フォルダをシート上に表示
    g_cntPATH = g_cntPATH + 1                   ' 参照フォルダ数を加算
'    GYO = GYO + 1                               ' 行を加算
    col = col + 1                               ' カラムを加算
    
'    If Len(Trim(Cells(GYO, 2).Value)) <= 0 Then
'        Ce

'    End If
    
    ' ■先ずサブフォルダを探索するループ処理
    For Each objPATH2 In objPATH.SubFolders
        ' フォルダ単位のサブ処理(再帰呼び出し)
        Cells(GYO, 2).Value = Cells(GYO, 2).Value & "\" & objPATH2.Name
        Call SEARCH_SUB_FOLDER(strPathName, objPATH2, GYO, col)
    Next objPATH2

    ' ■本フォルダの各ファイルをシート上に表示するループ処理
    col = col + 1                               ' カラムを加算
    For Each objFILE In objPATH.Files
        g_cntFILE = g_cntFILE + 1               ' 参照ファイル数
        With objFILE
            ' ファイル名+(最終更新日時+ファイルサイズ)
            Cells(GYO, 3).Value = .Name
            ActiveSheet.Hyperlinks.Add Anchor:=Cells(GYO, 3), Address:=objPATH & "\" & Cells(GYO, 3).Value
            Cells(GYO, 4).Value = Format(.DateLastModified, "YYYY/MM/DD")
            Cells(GYO, 5).Value = Format(.DateLastModified, "HH:NN:SS")
            Cells(GYO, 6).Value = Format(.Size, "#,##0")
            GYO = GYO + 1                           ' 行を加算
        End With
    Next objFILE
    ' 参照OBJECTを破棄
    Set objPATH = Nothing
Exit_SEARCH_SUB_FOLDER:
    Exit Sub

ERR_SEARCH_SUB_FOLDER:
    MsgBox Err.Description
End Sub

Sub FileSearch(fname As String, Path As String, GYO As Long)
Dim fso As Object, Folder As Variant
    
    Set fso = CreateObject("Scripting.FileSystemObject")

    For Each Folder In fso.getFolder(Path).SubFolders
        Call FileSearch(fname, Folder.Path, GYO)
    Next Folder

    If fso.FileExists(Path & "\" & fname) Then 'ここ修正 Pathから指定する
'        Debug.Print fname & "が" & Path & "に存在します" 'ここ修正 PathXは不要
'        Debug.Print "ファイルサイズ=" & FileLen(Path & "\" & fname)
        Call GET_ATTRIBUTE(Path & "\" & fname, GYO)
    End If
End Sub

' ファイルの属性の取得
Sub GET_ATTRIBUTE(strFILENAME As String, GYO As Long)
    Const cnsTITLE = "ファイルの属性の取得"
    Const cnsATTR = "このファイルの属性は"
    Dim xlAPP As Application
    Dim intAttr As Integer
    Dim strMSG As String

'    Set xlAPP = Application
'    ' ﾌｧｲﾙ名の指定
'    strFILENAME = _
'        xlAPP.GetOpenFilename("全てのファイル (*.*),*.*", , _
'        cnsTITLE)
'    If StrConv(strFILENAME, vbUpperCase) = "FALSE" Then
'        Exit Sub
'    End If

    ' ﾌｧｲﾙ属性の取得
    intAttr = GetAttr(strFILENAME)                      ' ①
    ' ﾌｧｲﾙ属性の判定
    strMSG = cnsATTR
    If (intAttr And vbReadOnly) <> 0 Then               ' ②
        strMSG = strMSG & vbCr & "読み取り専用"
    End If
    If (intAttr And vbHidden) <> 0 Then
        strMSG = strMSG & vbCr & "隠しファイル"
    End If
    If (intAttr And vbSystem) <> 0 Then
        strMSG = strMSG & vbCr & "システムファイル"
    End If
    If (intAttr And vbDirectory) <> 0 Then
        strMSG = strMSG & vbCr & "フォルダ"
    End If
    If (intAttr And vbArchive) <> 0 Then
        strMSG = strMSG & vbCr & "アーカイブ"
    End If
    If (intAttr And vbNormal) <> 0 Then
        strMSG = strMSG & vbCr & "通常ファイル"
    End If
    If strMSG = cnsATTR Then
        strMSG = strMSG & vbCr & "属性=" & intAttr
    End If
    strMSG = strMSG & vbCr & "です。"

    ' 更新日時
'    strMSG = strMSG & vbCr & "更新日時は" & _
'        FileDateTime(strFILENAME)                       ' ③
    Cells(GYO, 9).Value = Format(FileDateTime(strFILENAME), "YYYY/MM/DD")       '日付
    Cells(GYO, 10).Value = Format(FileDateTime(strFILENAME), "HH:MM:SS")        '時刻
    
    ' ファイルサイズ
    strMSG = strMSG & vbCr & "サイズは" & _
        FileLen(strFILENAME) & "バイトです。"           ' ④

    ' 処理結果を表示
    Debug.Print strMSG

End Sub
```