Neuigkeiten:

Wenn ihr euch für eine gute Antwort bedanken möchtet, im entsprechenden Posting einfach den Knopf "sag Danke" drücken!

Mobiles Hauptmenü

Frage zum vergleichen von Ordnern

Begonnen von Gockel67, Heute um 11:30:02

⏪ vorheriges - nächstes ⏩

Gockel67

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