Ordner rekursiv nur nach Ordnern durchsuchen

[LuckyJoe]

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!

[schauan]

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 *.

[Jeanie]

Hallo 
und bitte nicht mit Directories nach mir werfen

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

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

[LuckyJoe]

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.

[schauan]

Hallo Joe,

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

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

[Jeanie]

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:

[Kuwer]

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.  

Gruß Uwe

[LuckyJoe]

Hallo zusammen,

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