Please Help Me Modify This Code to include Subdirectories

Hi all. I made a small app that looks for all the jpgs in a directory and assigns them to a strArray by pathname. The code I found here on the forum looks like this:

***************************************************
Sub p_List_Directories(str_Path As String)
'PURPOSE: Add Back Slash
If Right(str_Path, 1) <> "\" Then str_Path = str_Path & "\"

'PURPOSE: Get the first file
str_Path = Dir(str_Path & "*.*")
Do Until str_Path = ""

'PURPOSE: Add it to the Listbox
strPath3 = StrConv(str_Path, vbProperCase)
If Right$(strPath3, 3) = "jpg" Then List1.AddItem strPath3

'PURPOSE: Get the next file
str_Path = Dir()
Loop


intNumFiles = List1.ListCount
For intNum = 0 To intNumFiles
strFile(intNum) = List1.List(intNum)
Next intNum
*****************************************************

Okay, the question is, how can i change this code so that it goes on to find all the jpgs in all the subdirectory folders inside this folder and also adds them to the strArray.

If anybody knows, I would really appreciate if you could let me in on it.

Thanks a lot.

Wengang

You need the microsoft scripting control to do this ... It's the only way I know how to do this ... You can get the directory name rather quickly.

Code:

---

'Code was tested and verified to work with VB6 Pro
Dim f As Object

Private Sub Command1_Click()
    Dim fol As Object

    Set fol = f.GetFolder(<Your Path Here>)
    For Each Folder In fol.SubFolders
        MsgBox Folder.Name
    Next
End Sub

Private Sub Form_Load()
    Set f = CreateObject("Scripting.FileSystemObject")
End Sub

---

Now, this is just an example on how to get the subfolders out of a given path. You could assign each folder to an array element and cycle through your subfolders using syntax as such:

Code:

---

'Code was tested and verified to work with VB6 Pro
Dim f As Object
Dim subFol() As String

Private Sub Command1_Click()
    Dim fol As Object
    Dim cntFol As Long

    Set fol = f.GetFolder(<Your Path Here>)

    ReDim subFol(fol.SubFolders.Count - 1)

    For Each Folder In fol.SubFolders
        subFol(cntFol) = Folder.Name
        cntFol = cntFol + 1
    Next
End Sub

Private Sub Form_Load()
    Set f = CreateObject("Scripting.FileSystemObject")
End Sub

---

This should suit your purposes. Once the subFol array has everything assigned, you can cycle through it to pull any other files that are located in it. (You can also use the FileSystemObject to pull file names as well.)

Hope this helps ya out ;)

Hi.
Thanks for the code.
but using this, i get a stop on the word 'Folder' as undefined variable.

I put a reference to the scripting control.

Any ideas?

If you're using Option Explicit, Use Dim Folder As Variant and that will hopefully take care of that.

You can't search recursively with the Dir function so you need to use the findfirst findnext API's

Code:

---

Option Explicit

Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_DIRECTORY = &H10

Private Type FILETIME
  dwLowDateTime    As Long
  dwHighDateTime    As Long
End Type

Private 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 * 260
  cAlternate        As String * 14
End Type

Private Declare Function FindFirstFile _
    Lib "kernel32" Alias "FindFirstFileA" ( _
    ByVal lpFileName As String, _
    lpFindFileData As WIN32_FIND_DATA) As Long
 
Private Declare Function FindNextFile _
    Lib "kernel32" Alias "FindNextFileA" ( _
    ByVal hFindFile As Long, _
    lpFindFileData As WIN32_FIND_DATA) As Long

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

Dim WFD As WIN32_FIND_DATA
Dim fExt$, fDir$, Num%


Private Sub searchForFiles(ByVal startPath$, ByVal match$)
    Dim fPath$, fName$, fPathName$
    Dim hfind&, nameLen%, matchLen%
    Dim WFD As WIN32_FIND_DATA
    Dim found As Boolean
   
    fPath = startPath
    If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
    matchLen = Len(match)
    match = LCase$(match)
         
    hfind = FindFirstFile(fPath & "*", WFD)
    found = (hfind > 0)
   
    Do While found
        fName = TrimNull(WFD.cFileName)
        nameLen = Len(fName)
        fPathName = fPath & fName
       
        If fName = "." Or fName = ".." Then
   
        ElseIf WFD.dwFileAttributes And _
          FILE_ATTRIBUTE_DIRECTORY Then
            searchForFiles fPathName, match
           
        ElseIf matchLen > nameLen Then
       
        ElseIf LCase$(Right$(fName, matchLen)) = match Then
            'Debug.Print fName
            List1.AddItem fPathName
        End If
       
        found = FindNextFile(hfind, WFD)
    Loop
    FindClose hfind
End Sub

Private Function TrimNull(ByVal Item As String) As String
    Dim pos As Integer
   
    pos = InStr(Item, Chr$(0))
    If pos Then Item = Left$(Item, pos - 1)
   
    TrimNull = Item
End Function

---

Makai,
Hi. It looks like your code functions the same way as the Windows Find Files...

My question is, how do I call this sub. It requires to variables in the index and then it says there should be an equal sign. I didn't know what to put in the index or what to set it equal to.

Well, i am wondering, if you have a minute could you show me a sample of a sub that calls this sub to populate the listbox with all files in the directory & subdirectories that are jpg's?

I really appreciate the help from both of you.

Thanks

With my code:

Code:

---

'Verified to work with VB6 w/ Microsoft Scripting ...

Dim f As Object
Dim Fil As Object

Dim subFol As New Collection
Dim allJPEGs As New Collection

Private Sub Command1_Click()
    Dim fol As Object
    Dim MyPath As String

    MyPath = InputBox("Please Enter a Beginning Path.")
    If MyPath = "" Then Exit Sub
    If f.FolderExists(MyPath) = True Then
        If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
        Set fol = f.GetFolder(MyPath)
        subFol.Add fol.Path, fol.Path
        GetAllJPEGs (fol.Path)
        For Each Folder In fol.SubFolders
            subFol.Add Folder.Path & "\", Folder.Path
            RecurseSubFolders (subFol.Item(Folder.Path))
        Next
        Else
        MsgBox "Folder does not exist."
    End If
End Sub

Private Sub RecurseSubFolders(rPath As String)
    Dim fol As Object
   
    Set fol = f.GetFolder(rPath)
    For Each Folder In fol.SubFolders
        subFol.Add Folder.Path & "\", Folder.Path
        GetAllJPEGs (subFol.Item(Folder.Path))
    Next
End Sub


Private Sub Command2_Click()
    Text1.Visible = False
    Text1.Text = ""
    For Each JPEG In allJPEGs
        Text1.Text = Text1.Text & JPEG & vbCrLf
    Next
    Text1.Visible = True
End Sub

Private Sub Form_Load()
    Set f = CreateObject("Scripting.FileSystemObject")
End Sub

Private Sub GetAllJPEGs(FilePath As String)
'Add The path and the name of a .jpg file to the collection
    Dim subFol As Object
    Set subFol = f.GetFolder(FilePath)
   
    For Each File In subFol.Files
        If f.GetExtensionName(File) = "jpg" Then
            allJPEGs.Add File.Name, FilePath & "\" & File.Name
        End If
    Next
End Sub

---

This is a pretty crude example. But here's what it does:
First, I got rid of the arrays, too much hassle when dealing with objects ;) Then, I added 2 collections, one for the subfolders (not really necessary, but it can be used) and another for the Files. The GetAllJPEGs sub filters out anything that doesn't have a .jpg extension, and those that do are added to the collection.

In command2, we spit all the files out to text1.text.

This can take a few minutes, but It's about the only way I know how to do it without the API.

What you'll need for this example to work?
Microsoft Scripting
2 Command Buttons (Command1, Command2)
1 TextBox (Text1)

Hope this helps you out.

*update* Ahh, I didn't see the listbox ...
Change the code for Command2 to this instead:

Code:

---

Private Sub Command2_Click()
    List1.Visible = False
    List1.Clear
    For Each JPEG In allJPEGs
        List1.AddItem JPEG
    Next
    List1.Visible = True
End Sub

---

Also, replace the textbox with a listbox.

[Edited by ExcalibursZone on 10-07-2000 at 03:53 AM]

I made this code yesterday for a completely different purpose, but it would work fine with a little alteration.

(you must use the project menu to set a reference to the Microsoft Scripting Runtime (scrrun.dll) to use this. this will take all of 5 seconds to do!)

to try this just put a button and a listbox on a form, it will add every single file and every single folder's names (that live under the "c:\windows\desktop") to the listbox.

This shows that you dont need bloated API code to do something this simple............

Code:

---

Option Explicit

Dim MyFSO As New FileSystemObject
Dim FSOFolder As Folder

Sub RecurseDirs(MyFolder As Folder)

Dim FSOSubFolders As Folders
Dim FSOFiles As Files
Dim FSOFile As File
Dim TempFolder As Folder

Set FSOSubFolders = MyFolder.SubFolders
For Each TempFolder In SF
    List1.AddItem "DIR... " & TempFolder.Path
    Call RecurseDirs(TempFolder)
Next TempFolder

Set FSOFiles = MyFolder.Files
For Each FSOFile In FSOFiles
    List1.AddItem FSOFile.Path
Next FSOFile

End Sub

Private Sub Command1_Click()

List1.Clear
Set FSOFolder = MyFSO.GetFolder("C:\Windows\desktop")
Call RecurseDirs(FSOFolder)

End Sub

---

API can be better because you need to include the FSO Runtime to make sure the Client has it on his machine!

Well that could be said about API (in some cases, dont know about this one) because the DLL's that contain the API declarations must be on the Client PC.

Anyway my code is far easier to debug because it is simple, having said that, its taken me ages to get a good understanding of recursion, probably one of the trickiest concepts in programming in my opinion. What do you think?

:)