NonSoft

VBSやVBAでフォルダ比較し差分を出力する方法

 ち〜な〜み〜に〜

VBS(VB SCRIPT/WSH)やVBAで手軽にフォルダ比較し差分を出力する方法をご紹介します。

フォルダ差分とはフォルダ内のファイル一覧を比較して更新日時が変更されたファイルや
追加または削除されたファイル一覧を意味します。

ファイル差分関係のその他のサンプルソースはこちらです。
VBSやVBAでファイル比較し差分を出力する方法
VBSやVBAでファイルの変更を監視する方法
VBSやVBAでフォルダの変更を監視する方法

コマンドライン(バッチ)でファイル比較(フォルダ比較)する方法はこちらです。
コマンドライン(バッチ)でファイル比較する方法

フォルダ差分(ファイル差分)関係のその他のツールやサンプルソースはこちらです。
ファイル比較／フォルダ比較(ツール＆サンプル)
ファイル監視／フォルダ監視(ツール＆サンプル)
★フォルダ比較サンプルソース 
' --------------------------------------------------------------------
' 比較するフォルダの設定
fol_path1 = "D:\Temp\test1"
fol_path2 = "D:\Temp\test2"

' (フォルダ1)フォルダ内のファイル一覧(更新日時付き)の取得
Redim path_list1(0)
GetFDate fol_path1, path_list1

' (フォルダ2)フォルダ内のファイル一覧(更新日時付き)の取得
Redim path_list2(0)
GetFDate fol_path2, path_list2

' フォルダ1とフォルダ2のファイル一覧(更新日時付き)の比較
Redim comp_list(0)
FComp path_list1, path_list2, comp_list

' 比較結果表示
If Ubound(comp_list) > 0 Then
    For i = 1 To Ubound(comp_list)
        MsgBox comp_list(i)
    Next
Else
    MsgBox "変更ファイル無し"
End If
' --------------------------------------------------------------------

' フォルダ内のファイル一覧(更新日時付き)の取得------------------------
Public Sub GetFDate(ByVal fol_path, ByRef path_list())
    Set fso = CreateObject("Scripting.FileSystemObject")

    For Each f In fso.GetFolder(fol_path).files
        ReDim Preserve path_list(UBound(path_list) + 1)
        path_list(UBound(path_list)) = _
            Mid(f.path, Len(fol_path) + 2) & vbTab & _
            fso.GetFile(f.path).DateLastModified
    Next

    For Each f In fso.GetFolder(fol_path).SubFolders
        GetFDate f.path, path_list
    Next

    Set fso = Nothing
End Sub
' --------------------------------------------------------------------

' ファイル一覧(更新日時付き)の比較------------------------------------
Public Sub FComp(ByRef ls1(), ByRef ls2(), ByRef comp_list())
    p1 = 1
    p2 = 1
    Do
        If p1 > Ubound(ls1) And p2 > Ubound(ls2) Then
            Exit Do
        End If

        fd1 = ""
        fd2 = ""
        If p1 <= Ubound(ls1) Then
            fd1 = Split(ls1(p1), vbTab)
        End If
        If p2 <= Ubound(ls2) Then
            fd2 = Split(ls2(p2), vbTab)
        End If

        If IsArray(fd1) = True And IsArray(fd2) = True Then
            fn1 = LCase(fd1(0))
            fn2 = LCase(fd2(0))
            If fn1 = fn2 Then
                If fd1(1) = fd2(1) Then
                ElseIf fd1(1) <> fd2(1) Then
                    ReDim Preserve comp_list(UBound(comp_list) + 1)
                    comp_list(UBound(comp_list)) = "(Mod)" & fd1(0)
                End If
                p1 = p1 +1
                p2 = p2 +1
            ElseIf fn1 < fn2 Then
                ReDim Preserve comp_list(UBound(comp_list) + 1)
                comp_list(UBound(comp_list)) = "(Del)" & fd1(0)
                p1 = p1 +1
            ElseIf fn1 > fn2 Then
                ReDim Preserve comp_list(UBound(comp_list) + 1)
                comp_list(UBound(comp_list)) = "(Add)" & fd2(0)
                p2 = p2 +1
            End If
        ElseIf IsArray(fd1) = True And IsArray(fd2) = False Then
            ReDim Preserve comp_list(UBound(comp_list) + 1)
            comp_list(UBound(comp_list)) = "(Del)" & fd1(0)
            p1 = p1 +1
        ElseIf IsArray(fd1) = False And IsArray(fd2) = True Then
            ReDim Preserve comp_list(UBound(comp_list) + 1)
            comp_list(UBound(comp_list)) = "(Add)" & fd2(0)
            p2 = p2 +1
        Else
            p1 = p1 +1
            p2 = p2 +1
        End If
    Loop
End Sub
' --------------------------------------------------------------------