Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0414: Ordner mit Dir$ rekursiv durchsuchen

 von 

Beschreibung 

Im Vergleich zu Tipp Tipp 128 arbeitet dieser Tipp mit der VB-eigenen Funktion Dir$. Dies hat aber den Nachteil, um einiges langsamer zu sein als die API-Funktionen. Das vorgestellte Modul gestattet es, die erfassten Dateien entweder in einer Textdatei oder in einem Array zu speichern.

Update von Mgalpha & Jochen Wierum am 26.12.03:
a) Der Tipp funktioniert nun auch unter Windows NT-Systemen.
b) Ein Fehler beim Erfassen der Unterordner wurde behoben.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

keine

Download:

Download des Beispielprojektes [2,56 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Modul "Module1" alias Module1.bas ---------


'Autor: R. Mueller
'E-Mail: r.mueller@sz-online.de

'Beitrag zum Thema Ordner und Laufwerke nach bestimmten oder
'allen Dateien rekursiv durchsuchen Beide dargestellten
'Varianten benutzen keine API sondern die Function Dir$

'1.Variante: Liste speichern in Datei
'2.Variante: Liste speichern Datenfeld

'Anmerkung: Die Ausgabe erfolgt zu Testzwecken sowohl im Debug-
'            Fenster als auch und in der Datei "C:\Test.txt"

Option Explicit

Public Sub Main()
    'Pfad durchsuchen
    Dim xpath As String
    
    'gesuchte Files keine Platzhalter
    Dim xSF As String
    Dim xfn As Long
    
    'Dateiname zum Speichern der Liste
    Dim xdn As String
    
    'Datenfeld zum Speichern der Liste
    ReDim xArray(0) As String
    
    'Array index
    Dim xln As Long
    Dim xi As Long
    
    'gesamtes Laufwerk durchsuchen
    'xpath = "D:"
    
    'Pfad durchsuchen z.B.
    'xpath = "D:\Eigene Dateien"
    
    xpath = Environ("USERPROFILE")
    
    'gesuchter Filename enthält folgenden String z.B.:
    'xSF = ".EXE" 'oder
    'xSF = ".v"   'oder
    'xSF = ".doc"
    
    xSF = ".htm"
    
    xSF = UCase(xSF)
    
    '1.Variante: Liste speichern in Datei
    xdn = "C:\Test.txt"  'Dateiname zum Speichern der Liste
    xfn = FreeFile
    Open xdn For Output As xfn
    Call xDirFile(xpath, xfn, xSF)
    Close xfn
    
    '2.Variante: Liste speichern Datenfeld
    Call xDirArray(xpath, xArray(), xln, xSF)
    
    'Ausgabe Array inhalt z.B.:
    For xi = 1 To UBound(xArray)
        Debug.Print xArray(xi)
    Next xi
End Sub

Public Sub xDirFile(xpath As String, xfn As Long, xSF As String)
    Dim xa As Long
    Dim xDir As String
    ReDim xt(0) As String
    Dim xi As Long
    Dim xAc As String
    
    xDir = Dir(xpath & "\*.*", vbNormal Or vbReadOnly Or vbHidden _
        Or vbSystem Or vbVolume Or vbDirectory Or vbArchive)
    
    xa = 0
    
    If Len(xDir) > 0 Then
        xt(0) = xDir
    End If
    
    Do While Len(xDir) > 0
        xDir = Dir
        If Len(xDir) > 0 And Not xDir = "." And Not xDir = ".." Then
            
            xa = xa + 1
            ReDim Preserve xt(xa)
            xt(xa) = xDir
        End If
    Loop
    
    For xi = 0 To xa
        If Len(xt(xi)) = 0 Then
            Exit For
        ElseIf Not xt(xi) = "." And Not xt(xi) = ".." Then
            If Len(Dir$(xpath & "\" & xt(xi), vbNormal Or vbReadOnly Or vbHidden _
                Or vbSystem Or vbVolume Or vbDirectory Or vbArchive)) > 0 Then
                
                If Not (GetAttr(xpath & "\" & xt(xi)) And vbDirectory) = vbDirectory Then
                    
                    If Len(xSF) > 0 Then
                        If InStr(1, UCase(xt(xi)), xSF) > 0 Then
                            xAc = xpath & "\" & xt(xi)
                            Print #xfn, xAc
                        End If
                    End If
                Else
                    Call xDirFile(xpath & "\" & xt(xi), xfn, xSF)
                End If
            End If
        End If
    Next xi
End Sub

Public Sub xDirArray(xpath As String, xArray() As String, xln As Long, xSF As String)
    Dim xa As Long
    Dim xDir As String
    ReDim xt(0) As String
    Dim xi As Long
    
    xDir = Dir$(xpath & "\*.*", vbNormal Or vbReadOnly Or vbHidden _
        Or vbSystem Or vbVolume Or vbDirectory Or vbArchive)
    
    '"\*.*" darf nicht verändert werden
    xa = 0
    
    If Len(xDir) > 0 Then
        xt(0) = xDir
    End If
    
    Do While Len(xDir) > 0
        xDir = Dir
        If Len(xDir) > 0 And Not xDir = "." And Not xDir = ".." Then
            
            xa = xa + 1
            ReDim Preserve xt(xa)
            xt(xa) = xDir
        End If
    Loop
    
    For xi = 0 To xa
        If Len(xt(xi)) = 0 Then
            Exit For
        ElseIf Not xt(xi) = "." And Not xt(xi) = ".." Then
            If Len(Dir(xpath & "\" & xt(xi), vbNormal Or vbReadOnly Or vbHidden _
                Or vbSystem Or vbVolume Or vbDirectory Or vbArchive)) > 0 Then
                
                'vbDirectory =16
                If Not (GetAttr(xpath & "\" & xt(xi)) And vbDirectory) = vbDirectory Then
                    
                    If Len(xSF) > 0 Then
                        If InStr(1, UCase(xt(xi)), xSF) > 0 Then
                            xln = xln + 1
                            ReDim Preserve xArray(xln)
                            xArray(xln) = xpath & "\" & xt(xi)
                        End If
                    End If
                Else
                    Call xDirArray(xpath & "\" & xt(xi), xArray(), xln, xSF)
                End If
            End If
        End If
    Next xi
End Sub
'---------- Ende Modul "Module1" alias Module1.bas ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 7 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Johann am 30.10.2008 um 23:29

Hallo Leute der Code hier oben hat mir bei meine Problem weitergeholfen ^^.

Ich kann den Code aber nicht ganz nachvollziehen vor in der Methode xDirFile sind keine Kommentare...

Wenn jemand die Methode / Funktion xDirFile etwas genauer erklären könnte wäre das Hilfreich ^_^.. Ich will nicht nur dass das Programm funktioniert ich will verstehen was dahinter steht.

Kommentar von Hans am 16.12.2006 um 12:18

Bei mir steigt der Aufruf mit der Fehlermeldung Laufzeitfehler 52 aus. (Windows XP Prof SP2).
Habe beim nachprüfen festgestellt das der Code mit dem Ordner "System Volume Information" nicht zurecht kommt.
Und zwar in diesem Abschnitt:

xDir = Dir(xpath & "\*.*", vbNormal Or vbReadOnly Or vbHidden Or vbSystem Or vbVolume Or vbDirectory Or vbArchive)

Gibt es hierzu Erkenntnisse wie der Fehler zu beheben ist ?

Codebsp ist eingebunden in einem Code der erstmal alle Festplattenlaufwerke ermittelt, Dann soll der Bsp. bestimmte Dateien auf dem HDD-Laufwerk finden, wobei alle zu prüfen sind. und abschließend sind bestimmt Dateien umzubennen.
Der Code ist soweit fertig nur der genannte Beispielcode macht noch Probleme. Oder gibt es gar eine Lösung wo ich diesen BspCode nicht benötige?

Kommentar von Josef am 25.03.2005 um 17:05

Funktioniert nur bis max 12 Subdirekriries

Kommentar von elite01 am 16.12.2001 um 14:37

Kann jemand die Subs xDirArray und xDirFile und deren Argumente beschreiben?

Kommentar von Oliver Hausler am 18.11.2001 um 13:30

Zu deinem Kommentar: du sagst, nur die 63 liefert alle Dateien, aber das wäre nicht dokumentiert. Mit 31 müsste es auch gehen. Habs nicht probiert, aber die Werte sind dual und du kannst durch Addition der Konstanten entscheiden, was du alles für Files brauchst. Dadurch werden im Register die entsprechenden Bits gesetzt, die die Funktion dir() auswertet.

Kommentar von void am 28.08.2001 um 15:13

Ja, daz izt allez richtig

Kommentar von r.mueller@sz-online.de am 06.08.2001 um 21:54

Antwort auf die Notiz von ricardo.gomez
Genau darin besteht das Prinzip eines recursiven
Prozeduraufrufs das ist kein Fehler das soll und muß so
sein . In jeder Aufrufebene kommt eine Directority Ebene
dazu. Dir wird sicher entgangen sein, das nur Directorys
einen recursiven Aufruf auslösen.
Du kannst dies ruhig ausgiebig Testen.
Übrigens bedeutend schneller ist
im Up-Download FileSearch.Zip