Moin Gemeinde,
ich habe mir aus dem Netz einen Code gezogen um zwei Verzeichnisse miteinander zu vergleichen.
Fehlende Dateien vom zweiten Laufwerk werden in einem Textfeld angezeigt.
Die Sache hat leider einen Schönheitsfehler. Wenn ein Ordner komplett fehlt wird dies ignoriert.
Ist es möglich fehlende Ordner anzuzeigen? Meine Kenntnisse reichen dafür leider nicht aus.
Wäre lieb von euch wenn mal einer drüber gucken könnte.
Hier der Code:
Option Compare Database
Option Explicit
' Benötigt Verweis auf Microsoft Scripting Runtime
Sub VerzeichnisseVergleichen()
Dim fso As FileSystemObject
Dim folderA As folder, folderB As folder
Dim pathA As String, pathB As String
pathA = CurrentProject.path & "\Anlagen"
pathB = Ziel & "Anlagen"
Set fso = New FileSystemObject
If Not fso.FolderExists(pathA) Or Not fso.FolderExists(pathB) Then
MsgBox "Einer der Ordner existiert nicht.", vbCritical
Exit Sub
End If
Set folderA = fso.GetFolder(pathA)
Set folderB = fso.GetFolder(pathB)
TextVergleich.Value = "--- Vergleich gestartet ---" & vbCrLf
' Rekursiver Aufruf für Ordner A
CompareFolders folderA, folderB, fso
TextVergleich.Value = TextVergleich.Value & "--- Vergleich beendet ---"
End Sub
Sub CompareFolders(fldA As folder, fldB As folder, fso As FileSystemObject)
Dim subFldA As folder
Dim fileA As file
Dim targetFilePath As String
' Dateien im aktuellen Ordner A mit Ordner B vergleichen
For Each fileA In fldA.Files
targetFilePath = fldB.path & "\" & fileA.Name
Laufwerk1.Caption = fileA.Name
If Not fso.FileExists(targetFilePath) Then
TextVergleich.Value = TextVergleich.Value & "Fehlt in Ziel: " & fileA.path & vbCrLf
Else
' Optional: Dateigröße/Datum prüfen
Dim fileB As file
Set fileB = fso.GetFile(targetFilePath)
If fileA.Size <> fileB.Size Or fileA.DateLastModified <> fileB.DateLastModified Then
TextVergleich.Value = TextVergleich.Value & "Unterschiedlich: " & fileA.Name & vbCrLf
End If
End If
Next fileA
' Unterordner rekursiv durchlaufen
For Each subFldA In fldA.SubFolders
' Hier müsste logisch das entsprechende Unterverzeichnis in B gesucht werden
' Dieser vereinfachte Code prüft nur die flache Struktur der Unterordner.
If fso.FolderExists(fldB.path & "\" & subFldA.Name) Then
CompareFolders subFldA, fso.GetFolder(fldB.path & "\" & subFldA.Name), fso
End If
Next subFldA
End Sub
Private Sub btnVergleichStarten_Click()
VerzeichnisseVergleichen
End Sub
Private Sub Form_Load()
TextVergleich.Value = ""
Laufwerk1.Caption = ""
End Sub
Wünsche allen einen schönen Tag
Jörg