VBA Excel recursive folder search stops

Question

I have script to scan a folder for files with a file name containing a certain text. The script works but it stops after sometime without finishing the scan of the complete folder (I reached 16663 scans, is there a limit?). I can't figure out why the script stops. Any help is greatly appreciated.

I initially used the code posted in this post Get list of sub-directories in VBA

Update: The drive I'm scanning is a network drive. My assumption now is that due to a hick-up in the connection the script stops. At the moment I'm trying different approaches to work around this...

Sub LoopThroughFilePaths()

    Application.StatusBar = True
    Application.ScreenUpdating = False

    Counter = 1

    Dim strPath As String
    strPath = "V:\50"                            ' folder to scan

    Dim myArr
    myArr = GetSubFolders(strPath)

    Application.StatusBar = False
    Application.ScreenUpdating = True

End Sub

Used Function GetSubFolders

Function GetSubFolders(RootPath As String)

    Application.ScreenUpdating = False

    Dim fso As Object
    Dim fld As Object
    Dim sf As Object
    Dim myArr
    Dim output As String
    Dim StrFileOut As String
    VAR_01_output = "D:\output"                  'Location to copy found files to

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(RootPath)

    Dim StrFile As String
    StrFile = Dir(fld + "\*labsuite*")           'wild card search for files

    Do While Len(StrFile) > 0
        StrFileOut = Format(Now(), "hh-mm-ss") & "_" & StrFile ' rename files
        FileCopy fld + "\" + StrFile, VAR_01_output + "\" + StrFileOut 'copy found files to output folder
        StrFile = Dir
    Loop

    For Each sf In fld.SubFolders
        ReDim Preserve Arr(Counter)
        Arr(Counter) = sf.Path
        Counter = Counter + 1

        On Error Resume Next
        myArr = GetSubFolders(sf.Path)
        On Error Resume Next

        'ActiveWorkbook.Sheets(1).Cells(1, 1).Value = Counter
        Application.StatusBar = sf.Path

        DoEvents
    Next

    GetSubFolders = Arr

    Set sf = Nothing
    Set fld = Nothing
    Set fso = Nothing

End Function

How many files are in this folder? There shouldn't be a limit, but I'm surprised there are more than 16663 files in one folder — Marcucciboy2, Oct 22 '18 at 13:16
There are a lot of sub-folders and sub-sub-folders etc. containing a lot of files... Total nr. of files is probably +100000 — Klaas Siderius, Oct 22 '18 at 13:31
Lol that's embarrassing, of course the count includes subfolders... *facepalm* — Marcucciboy2, Oct 22 '18 at 13:32
FWIW each call to `GetSubFolders` creates an new instance of `FileSystemObject`. Don't do that, rather create one and pass a reference to it to the recursive routine — chris neilsen, Oct 22 '18 at 13:38
[Here's a better method](https://stackoverflow.com/a/14246818/445425) — chris neilsen, Oct 22 '18 at 13:50
@chrisneilsen I tried the method you posted, but I keep having the same problem... — Klaas Siderius, Oct 24 '18 at 05:58

VBA Excel recursive folder search stops

0 Answers0