Macro Issue: Code not detecting all subfolders

leggylongshanks

New Member
Joined
Dec 9, 2012
Messages
8
Hi all,

I'm using this piece of code to go through Folders and their Subfolders. It works quite well in going through the first folder and its sub's but does not seem to generate a full list. Maybe someone with a more experience will be able to see what is causing this.

I am looking for specific files in these folders, and depending in what folder I place the file, it may or may not detect it. I require the code to go at least 3 levels deep (sometimes more).

FolderName = "C:\test folder"
ProcessFiles FolderName, "*.xls"

Code:
'~~> This function was taken from
'~~> http://www.vbaexpress.com/kb/getarticle.php?kb_id=245
Sub ProcessFiles(strFolder As String, strFilePattern As String)
    Dim strFileName As String, strFolders() As String
    Dim i As Long, iFolderCount As Long


    '~~> Collect child folders
    On Error Resume Next
    strFileName = Dir$(strFolder & "\", vbDirectory)
    Do Until strFileName = ""
        If (GetAttr(strFolder & "\" & strFileName) And vbDirectory) = vbDirectory Then
            If Left$(strFileName, 1) <> "." Then
                ReDim Preserve strFolders(iFolderCount)
                strFolders(iFolderCount) = strFolder & "\" & strFileName
                iFolderCount = iFolderCount + 1
            End If
        End If
        strFileName = Dir$()
    Loop


    '~~> process files in current folder
    strFileName = Dir$(strFolder & "\" & strFilePattern)
    Do Until strFileName = ""
        wbCount = wbCount + 1
        ReDim Preserve wbList(1 To wbCount)
        wbList(wbCount) = strFolder & "\" & strFileName
        strFileName = Dir$()
    Loop


    '~~> Look through child folders
    For i = 0 To iFolderCount - 1
        ProcessFiles strFolders(i), strFilePattern
    Next i
End Sub
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
try this
Code:
Sub ListSubfoldersFile()
Dim StrFile As String
   Dim objFSO, destRow As Long
   Dim mainFolder, mySubFolder
   arow = 2
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   mFolder = "D:\test\" ' <<<<< to be changed
   Set mainFolder = objFSO.GetFolder(mFolder)
   StrFile = Dir(mFolder & "*.xls*")
   Do While Len(StrFile) > 0
     Cells(arow, 1).Value = mFolder & StrFile
     arow = arow + 1
     StrFile = Dir
   Loop
   For Each mySubFolder In mainFolder.SubFolders
     StrFile = Dir(mySubFolder & "\*.xls*")
     Do While Len(StrFile) > 0
        Cells(arow, 1).Value = mySubFolder & "\" & StrFile
        arow = arow + 1
        StrFile = Dir
     Loop
   Next
End Sub
 
Upvote 0
Thanks for the response.

Your code seems to go into subfolders and return the name of any .xls files, that part works fine. However, if there are any .xls files in that folder, it will not search any of the subfolders also in that folder.

The code I posted does do what I need it to, there may just be some logic flaw or hole somewhere that is causing it to not fully search through the specified folder.
 
Upvote 0
Code:
Sub ListSubfoldersFile1()
Dim StrFile As String
   Dim objFSO, destRow As Long
   Dim mainFolder, mySubFolder
   arow = 2
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   mFolder = "D:\DATI\prova\"
   Set mainFolder = objFSO.GetFolder(mFolder)
   StrFile = Dir(mFolder & "*.xls*")
   If Len(StrFile) > 0 Then
     Do While Len(StrFile) > 0
       Cells(arow, 1).Value = mFolder & StrFile
       arow = arow + 1
       StrFile = Dir
     Loop
     Exit Sub
   Else
     For Each mySubFolder In mainFolder.SubFolders
       StrFile = Dir(mySubFolder & "\*.xls*")
       If Len(StrFile) > 0 Then
         Do While Len(StrFile) > 0
           Cells(arow, 1).Value = mySubFolder & "\" & StrFile
           arow = arow + 1
           StrFile = Dir
         Loop
         Exit Sub
       End If
     Next
   End If
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,550
Messages
6,114,265
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top