Clever-Excel-Forum - Ordner rekursiv nur nach Ordnern durchsuchen

Hallo zusammen,

für die rekursive Suche nach Dateien in Ordnern und Unterordnern habe ich eine Routine gefunden:

Code:
Sub ListMyFiles()

    Dim colFiles As New Collection

    Dim i As Long

    Dim MyPfad As String

    Dim MyDatei As String

    MyPfad = "d:\MeineDaten"

    MyDatei = "FindeDieseDatei.txt"

    ListFilesInDir MyPfad, MyDatei, colFiles, True

    If colFiles.Count > 0 Then

        For i = 1 To colFiles.Count

            Debug.Print colFiles(i)

        Next i

    End If

End Sub

Private Sub ListFilesInDir(sStartPath As String, sPattern As String, colFullNames As Collection, Optional bInSubDirs As Boolean)

    On Error Resume Next

    Dim sTemp As String

    Dim sRepeat As String

    If Right(sStartPath, 1) <> "\" Then sStartPath = sStartPath & "\"

    sTemp = Dir(sStartPath & sPattern)

    Do While Len(sTemp)

        If sTemp <> "." And sTemp <> ".." Then

            If (GetAttr(sStartPath & sTemp) And vbDirectory) <> vbDirectory Then

                colFullNames.Add sStartPath & sTemp

            End If

        End If

        sTemp = Dir()

    Loop

    If bInSubDirs = True Then

        sTemp = Dir(sStartPath, vbDirectory)

        Do While Len(sTemp)

            If (sTemp <> ".") And (sTemp <> "..") Then

                If (GetAttr(sStartPath & sTemp) And vbDirectory) = vbDirectory Then

                    ListFilesInDir sStartPath & sTemp, sPattern, colFullNames, bInSubDirs

                    sRepeat = Dir(sStartPath, vbDirectory)

                    Do While sRepeat <> sTemp

                        sRepeat = Dir()

                    Loop

                End If

            End If

            sTemp = Dir()

        Loop

    End If

    On Error GoTo 0

End Sub

Wie kann ich aber ausschließlich nach Ordnern (rekursiv) suchen? Ich möchte z.B. in C:\ alle Verzeichnisse mit dem Namen "temp" finden?

Danke im Voraus!

Hallöchen,

Du könntest diese Zeile
colFullNames.Add sStartPath & sTemp

einfach ausscneiden und etwas weiter unten einfügen, wo wieder ... = vbdirectory ... steht

in Deinem ersten Makro wird ja festgelegt, nach was Du suchst. Da nimmst Du dann *.

Hallo
und bitte nicht mit Directories nach mir werfen Smile

da gibt es mehrere Möglichkeiten:

1. Du googles mal nach
vba loop directory

oder ähnlichem - ist immer besser in englisch zu googlen.

2. Und das wage ich mich kaum zu schreiben:
Du schaust dir mal deinen schon ergoogelten Code an, versuchst ihn zu verstehen und anzupassen - ist übrigens nicht schwer.
Mit ein wenig Nachdenken findest du die Positionen wo man eingreifen muss
Du wirst deinen Code zwar nicht optimieren zeitlich aber deinem Ziel näher kommen und mehr verstehen.
Ist die absolut zu empfehlende Variante (auch wenn der Code etwas fragwürdig ist)

3. In ein gutes Buch schauen, die haben gerade dazu viel Beispiele. Aber in deutsch gibt es da so nichts wirklich gutes Sad

4. Darauf warten, dass es dir jemand mundgerecht/schreibgerecht präsentiert.

Hallo schauan,

danke für deine Hilfe, ich habe die Zeile an die beschriebene Stelle "umgesetzt" - jetzt bekomme ich von dem vorgegebenen Startverzeichnis alle Unterverzeichnisse (und nur noch diese und keine Dateien) angezeigt; also schon mal der erste Schritt in die richtige Richtung. Ich bekomme es aber nicht hin, dass mir ein vorgegebenes Unterverzeichnis gelistet wird, also z.B.:

Ich starte bei "D:\MeineDaten\",
ich suche "temp" (als Verzeichnisname),
ich möchte erhalten:
- D:\MeineDaten\temp
- D:\MeineDaten\abc\temp
- D:\MeineDaten\xyz\Noch ein Verzeichnis\temp

Hallo Jeanie,

danke auch dir, aber:
Zu 1: ... glaube mir, ich habe bereits gesucht, englisch/deutsch. Letztendlich komme ich immer auf die 3 gleichen Ergebnisse:
1. API-Funktion von Nepumuk (http://www.office-loesung.de/ftopic148247_0_0_asc.php) → ist mir zu kompliziert
2. Der Einsatz des Scripting.FileSystemObject (http://www.office-loesung.de/ftopic199191_0_0_asc.php)
3. In etwa der Code, den ich gepostet habe.
Hierbei habe ich herausgefunden, dass die Methode 3 schneller als 2 ist und ich sie daher bevorzuge.

Zu 2/3: ...
a) glaube mir, dass ich mir den Code schon hinreichend angeschaut habe. Hätte ich ihn komplett verstanden und anpassen können, würde ich meine Frage nicht in diesem Forum stellen.
b) sei mir nicht böse, aber dein Hinweis, sich Codeschnipsel genauer anzuschauen und dann vielleicht irgendwann selber dahinter zu kommen, ist nicht wirklich hilfreich, das könntest du dann hier im Forum bei jedem dritten Posting antworten. Das gilt im übrigen auch für deinen Vorschlag für ein Buch. Wenn hier alle Fragesteller entsprechende Literatur verinnerlicht hätten, dann bräuchte man kein Forum. Sorry, aber ich fand meine Frage nun auch nicht völlig dämlich.

Nichts für ungut.

Hallo Joe,

ich hoffe ja, dass Du auch mit den Antworten hier im Forum dazu lernst Smile

Also, wenn Du die Verzeichnisse weiter einschränken willst, musst Du das an eine Bedingung knüpfen. Da hast Du ja schon einige im Code. Wenn - Dann ist im Englischen If - Then
Also im Prinzip

Wenn mein Suchwort enthalten ist, dann sammle den Pfad

Eine Bedingung nebst Aktion kann man einzeilig formulieren oder mehrzeilg, dann abschliessend mit End If.

If InStr(1, sStartPath & sTemp, sPattern) > 0 Then colFullNames.Add sStartPath & sTemp

oder

If InStr(1, sStartPath & sTemp, sPattern) > 0 Then
colFullNames.Add sStartPath & sTemp
End If

Wenn Du im ersten Code nun Temp mitgibst, dann werden Dir alle Pfade angezeigt, die Temp enthalten. Eventuell reicht das aber nicht.
Besser wäre in dem Fall, wenn Du nur die rechten Zeichen prüfst.

If Right(sStartPath & sTemp, 5) = "\" & sPattern Then colFullNames.Add sStartPath & sTemp

Übrigens, wenn Du neben Temp auch temp haben willst, muss man noch etwas hinzufügen Smile

(20.10.2017, 22:58)LuckyJoe schrieb: [ -> ]Hallo Jeanie,

danke auch dir, aber:
Zu 1: ... glaube mir, ich habe bereits gesucht, englisch/deutsch. Letztendlich komme ich immer auf die 3 gleichen Ergebnisse:
1. API-Funktion von Nepumuk (http://www.office-loesung.de/ftopic148247_0_0_asc.php) → ist mir zu kompliziert
2. Der Einsatz des Scripting.FileSystemObject (http://www.office-loesung.de/ftopic199191_0_0_asc.php)
3. In etwa der Code, den ich gepostet habe.
Hierbei habe ich herausgefunden, dass die Methode 3 schneller als 2 ist und ich sie daher bevorzuge.

Zu 2/3: ...
a) glaube mir, dass ich mir den Code schon hinreichend angeschaut habe. Hätte ich ihn komplett verstanden und anpassen können, würde ich meine Frage nicht in diesem Forum stellen.
b) sei mir nicht böse, aber dein Hinweis, sich Codeschnipsel genauer anzuschauen und dann vielleicht irgendwann selber dahinter zu kommen, ist nicht wirklich hilfreich, das könntest du dann hier im Forum bei jedem dritten Posting antworten. Das gilt im übrigen auch für deinen Vorschlag für ein Buch. Wenn hier alle Fragesteller entsprechende Literatur verinnerlicht hätten, dann bräuchte man kein Forum. Sorry, aber ich fand meine Frage nun auch nicht völlig dämlich.

Nichts für ungut.

Hallo LuckyJoe
Sorry, du hast vollkommen recht.
Ich habe wohl gestern zu lange programmiert,so dass ich vergessen habe, wie schwer es für den Einsteiger ist, selbst solch "einfachen" Code zu analysieren und zu bearbeiten.
Und dämlich war deine Frage nun wirklich nicht - nur meine Antwort :16:

Hallo Joe,

hier mal ein "fertiges" Beispiel:

Option Explicit



'Code von Bernd (bst)

'http://www.online-excel.de/fom/fo_read.php?f=3&bzh=121&h=120#a123x



'verändert von Kuwer



Dim Zeile As Long

Dim strDir() As String

Dim strDirName As String



Sub test()

  Worksheets(1).Activate

  Cells.Clear

  Zeile = 1

  strDirName = "tmp"

  Tree "D:\MeineDaten", "", False

End Sub



Sub Tree(actdir As String, filename As String, showfiles As Boolean)

  Dim fname

  Dim i As Integer, j As Integer

  Dim subdirs() As String



  Call ShowDir(actdir, filename, showfiles)

  i = 0

  fname = Dir(actdir & "\*.*", vbDirectory)

  While fname <> ""

     If fname <> "." And fname <> ".." And (GetAttr(actdir & "\" & fname) And vbDirectory) = vbDirectory Then

        i = i + 1

        ReDim Preserve subdirs(i)

        subdirs(i) = actdir & "\" & fname

     End If

     fname = Dir

  Wend

  For j = 1 To i

     Call Tree(subdirs(j), filename, showfiles)

  Next

  ReDim subdirs(0)

End Sub



Private Sub ShowDir(actdir As String, filename As String, showfiles As Boolean)

  Dim fname



  If showfiles Then

     fname = Dir(actdir & "\" & filename)

     While fname <> ""

        ReDim Preserve strDir(1 To Zeile)

        strDir(Zeile) = actdir & "\" & fname

        Cells(Zeile, 1).Value = actdir & "\" & fname

        Zeile = Zeile + 1

        fname = Dir

     Wend

  Else

     If Len(strDirName) = 0 Or Right(actdir, Len(strDirName) + 1) = "\" & strDirName Then

       ReDim Preserve strDir(1 To Zeile)

       strDir(Zeile) = actdir & "\" & fname

       Cells(Zeile, 1).Value = actdir

       Zeile = Zeile + 1

     End If

  End If

End Sub

Code eingefügt mit: Excel Code Jeanie

Leider ist der Thread, aus dem der Code von bst stammt, nicht mehr Online, so dass Du ihn auch nicht finden konntest. Undecided

Gruß Uwe

Hallo zusammen,

vielen Dank für eure Unterstützung, habe es hinbekommen ... manchmal steht man halt etwas auf dem Schlauch Wink