CompareDirectories - Find different files in two directories
Enum CompareDirectoryEnum
cdeSourceDirOnly = -2 ' file is present only in the source directory
cdeDestDirOnly = -1 ' file is present only in the dest directory
cdeEqual = 0 ' file is present in both directories,
' with same date, size, and attributes
cdeSourceIsNewer = 1 ' file in source dir is newer
cdeSourceIsOlder = 2 ' file in source dir is older
cdeDateDiffer = 3 ' date of files are different
cdeSizeDiffer = 4 ' size of files are different
cdeAttributesDiffer = 8 ' attributes of files are different
End Enum
' Compare files in two directories
'
' returns a two-dimensional array of variants, where arr(0,
' n) is the name of the N-th file
' and arr(1, n) is one of the CompareDirectoryEnum values
'
' NOTE: requires a reference to the Microsoft Scripting Runtime type library
'
' Usage example:
' ' compare the directories C:\DOCS and C:\BACKUP\DOCS
' Dim arr() As Variant, index As Long
' arr = CompareDirectories("C:\DOCS", "C:\BACKUP\DOCS")
' ' display files in C:\DOCS that should be copied into the backup directory
' ' because they are newer or because they aren't there
' For index = 1 To UBound(arr, 2)
' If arr(1, index) = cdeSourceDirOnly Or arr(1, index) = cdeSourceIsNewer
' Then
' Print arr(0, index)
' Next
Function CompareDirectories(ByVal sourceDir As String, ByVal destDir As String) _
As Variant()
Dim fso As New Scripting.FileSystemObject
Dim sourceFld As Scripting.Folder
Dim destFld As Scripting.Folder
Dim sourceFile As Scripting.File
Dim destFile As Scripting.File
Dim col As New Collection
Dim index As Long
Dim FileName As String
' get a reference to source and dest folders
Set sourceFld = fso.GetFolder(sourceDir)
Set destFld = fso.GetFolder(destDir)
' ensure that destination path has a trailing backslash
If Right$(destDir, 1) <> "\" Then destDir = destDir & "\"
' prepare result array - make it large enough
' (we will shrink it later)
ReDim res(1, sourceFld.Files.Count + destFld.Files.Count) As Variant
' we need to ignore errors, in case file doesn't exist in destination dir
On Error Resume Next
' load files of source directory into result array
For Each sourceFile In sourceFld.Files
' this is the name of the file
FileName = sourceFile.Name
' add file name to array
index = index + 1
res(0, index) = FileName
' add file name to collection (to be used later)
col.Add FileName, FileName
' try to get a reference to destination file
Set destFile = fso.GetFile(destDir & FileName)
If Err Then
Err.Clear
' file exists only in source directory
res(1, index) = cdeSourceDirOnly
Else
' if the file exists in both directories,
' start assuming it's the same file
res(1, index) = cdeEqual
' compare file dates
Select Case DateDiff("s", sourceFile.DateLastModified, _
destFile.DateLastModified)
Case Is < 0
' source file is newer
res(1, index) = cdeSourceIsNewer
Case Is > 0
' source file is newer
res(1, index) = cdeSourceIsOlder
End Select
' compare attributes
If sourceFile.Attributes <> destFile.Attributes Then
res(1, index) = res(1, index) Or cdeAttributesDiffer
End If
' compare size
If sourceFile.Size <> destFile.Size Then
res(1, index) = res(1, index) Or cdeSizeDiffer
End If
End If
Next
' now we only need to add all the files in destination directory
' that don't appear in the source directory
For Each destFile In destFld.Files
' it's faster to search in the collection
If col(destFile.Name) = "" Then
' we get here only if the filename isn't in the collection
' add the file to the result array
index = index + 1
res(0, index) = destFile.Name
' remember this only appears in the destination directory
res(1, index) = cdeDestDirOnly
End If
Next
' trim and return the result
If index > 0 Then
ReDim Preserve res(1, index) As Variant
CompareDirectories = res
End If
End Function