• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 669
  • Last Modified:

Parsing a directory, including sub directory

I'm using VB6, and decided to start thinking about a small utility project.  (I prefer to write my own small stuff, as I can usually get it faster than searching for something online.)

This project needs the ability to look through a given directory (folder, whatever), check for either a specific file or type of file (*.mp3, for example), and parse its way through any and all sub folders.  I admit that I haven't looked for the info much, as I have only just begun to plan the project.

Any ideas, including pseudo code would be helpfull.

3 Solutions
Hai, Mixael

Public Const MAX_PATH = 260
Public Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Public Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Public FCount As Long

Sub LoopFolders(sPath$)
Dim hFile As Long
Dim cont As Integer
Dim sFile As String

    cont = True
    sPath$ = bsl(sPath$)
    'find the first file matching the parameter \*.*
    hFile = FindFirstFile(sPath & "*.*" & Chr$(0), WFD)
    If hFile <> -1 Then
        While cont
            sFile = TrimNull(WFD.cFileName)
             'ignore the 2 standard root entries
            If (sFile <> ".") And (sFile <> "..") Then
                If (WFD.dwFileAttributes And vbDirectory) Then
                    FCount = FCount + 1
                    'Do your stuf here for dirs
                    'LoopFolders sPath & sFile 'recurse
                Else    'bestanden
                    'Do your stuf here for Files
                End If
            End If
            cont = FindNextFile(hFile, WFD)
    End If
    Call FindClose(hFile)
End Sub

Public Function bsl(Path$) As String
    If Right$(Path$, 1) = "\" Then
        bsl = Path$
        bsl = Path$ & "\"
    End If
End Function

here are some self explanitory function that should help you out

Function GetPath(FullPath As String) As String
    GetPath = Left(FullPath, Len(FullPath) - (InStr(1, StrReverse(FullPath), "\") - 1))
End Function

Function GetExtension(FullPath As String) As String
    GetExtension = Right(FullPath, Len(FullPath) - (InStr(1, (FullPath), ".") - 1))
End Function

Function GetFileName(FullPath As String) As String
    GetFileName = Left(Right(FullPath, Len(FullPath) - (InStr(1, StrReverse(FullPath), ".") - 1)), Len(Right(FullPath, Len(FullPath) - (InStr(1, StrReverse(FullPath), ".") - 1))) - Len(Right(FullPath, Len(FullPath) - (InStr(1, (FullPath), ".") - 1))))
End Function

Function FileExists(FullPath As String) As Boolean
    If Dir(FullPath) = "" Then
        FileExists = False
        FileExists = True
    End If
End Function

Mike TomlinsonMiddle School Assistant TeacherCommented:
Here is another way to do it using the built in methods from VB (the API method presented by VBtorment is the fastest).  I though I would present this method because it shows how to add the matches to collection.  Create a new project and add a CommandButton, Label and a TextBox.  For the TextBox, set the MultiLine property to True and the ScrollBars property to 3 - Both.

Option Explicit

Private matches As Collection

Private Sub Form_Load()
    Label1.Caption = ""
End Sub

Private Sub Command1_Click()
    Command1.Enabled = False

    Dim match As Variant
    Set matches = New Collection
    findFiles "C:\Documents and Settings\Michael\My Documents\", "*.txt"
    Text1.Text = ""
    For Each match In matches
        Text1.Text = Text1.Text & match & vbCrLf
    Label1.Caption = matches.Count & " file(s) found"
    Command1.Enabled = True
End Sub

Private Sub findFiles(ByVal basePath As String, ByVal filter As String)
    Dim curFile As String
    Dim subdir As Variant
    Dim subDirs As Collection
    ' add matching files in current directory
    curFile = Dir(basePath & filter)
    Do While curFile <> ""
        Label1.Caption = basePath & curFile
        matches.Add basePath & curFile
        curFile = Dir()
    ' build subDirs collection
    Set subDirs = New Collection
    curFile = Dir(basePath, vbDirectory)
        If curFile <> "" Then
            If (GetAttr(basePath & curFile) And vbDirectory) = vbDirectory Then
                If curFile <> "." And curFile <> ".." Then
                    subDirs.Add basePath & curFile & "\"
                End If
            End If
        End If
        curFile = Dir()
    Loop While curFile <> ""
    ' recurse into each subdir
    For Each subdir In subDirs
        findFiles subdir, filter
End Sub

MixaelAuthor Commented:
All three good answers, and have me pointed in the right direction.  Although I haven't tried any of these answers yet, I shall do so this weekend.  I felt that all three answers were on the mark, and split the points the way I did based only on the order the answers came in.  (I should have increased the point value first, but got ahead of myself.)  To be honest, I didn't expect any answers so soon!

Thanks for the answers.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now