Get Folder Names from server directory

Question

I need to get folder names with the path for which I need to search the directory in a server with about 6000 folders. I have the following snippet of code to run through the folder and get the folder names with path. It works fine in a local directory but when I run the same code on a server directory it fails after about printing 86 folder names. The code fails when run on server location with more than 6000 folders.

Private Sub PrintFolders()
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim i As Integer
Application.StatusBar = ""
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("C:\Temp")
i = 1
'loops through each folder in the directory and prints their names and path
On Error GoTo handleCancel
Application.EnableCancelKey = xlErrorHandler
MsgBox "This may take a long time: press ESC to cancel"
For Each objSubFolder In objFolder.subfolders
Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name
    'print folder name
    Cells(i + 1, 1) = objSubFolder.Name
    'print folder path
    Cells(i + 1, 2) = objSubFolder.Path
    i = i + 1
Next objSubFolder
handleCancel:
If Err = 18 Then
 MsgBox "You cancelled"
End If
End Sub

If you start with `i = 2`, you can dispense with `i + 1` in the `Cells()` references. Won't solve the problem, OK, highly unlikely it will solve the problem. Just a thought to simplify the code a smidge — FreeMan, Apr 09 '15 at 20:06
Also, no need to cross-post to [Code Review](http://codereview.stackexchange.com/questions/86441/excel-vba-get-folder-names), especially as this is a bug - it's a much better fit here. — FreeMan, Apr 09 '15 at 20:14
This gets my downvote here too. There's not enough information to solve the problem. You need to tell us where the code fails and how. What's the error? — RubberDuck, Apr 09 '15 at 20:18
Possibly helpful: http://stackoverflow.com/q/14720710/1188513 — Mathieu Guindon, Apr 09 '15 at 20:23
I am not sure how to catch the error but my excel freezes and eventually I have force close it. Is there anyway I can see if the application is still running — Anurag Singh, Apr 09 '15 at 20:33
`If i mod 10 = 0 Then Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name`. Gives you a nice little status every 10th folder. — FreeMan, Apr 09 '15 at 20:38
Have you tried stepping through (F8) to see if it is breaking at the same point each time? Maybe a particular path that it is having trouble with. — CactusCake, Apr 09 '15 at 21:13
@Freeman I have modified the code as follows, but after sometime my the statusbar doesn't update the folder names. I have put in the code application.enablecancelkey = xlErrorhandler to stop the code but that doesn't seem to be working as well. See above modified code — Anurag Singh, Apr 09 '15 at 21:55
Do you get a file that you can look at? That should give you a complete list of all the files that it's already processed. Maybe use the `If I mod 10 = 0` line then, if true, save your file. That way you should have it within the last 10. Maybe there's a weird file name that it's coming across that it can't handle. If you see the same path structure each time it dies, that would be the place to look. — FreeMan, Apr 09 '15 at 23:48
If it is failing at random points, I wonder if it is using up all your system memory somehow. Are the values that you're dumping into columns A & B being referenced by other functions, or do you have any volatile functions that are being given excessive work to do when this runs? If that is the culprit you could try turning off automatic calculations until the loop has finished. — CactusCake, Apr 10 '15 at 20:47

score 0 · Answer 1 · edited Apr 13 '15 at 15:04

After much discussion here is the final code that works correctly, works great.

Sub PrintFolders()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objSubFolder As Object
    Dim i As Integer
    Dim Folder_Name As String

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.StatusBar = ""
    On Error GoTo CleanFail

    Set wb = ThisWorkbook
    Set wsControl = wb.Sheets("Control"): Set wsOutput = wb.Sheets("Output")
    Folder_Name = wsControl.Cells(1, 2)
    If Folder_Name = "" Then
        MsgBox "Path location is not entered. Please enter path"
        wsControl.Cells(1, 2).Select
        End
    End If
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(Folder_Name)

    i = 1
    Dim MyArr() As Variant
    ReDim MyArr(1 To i, 1 To 2)

    Application.EnableCancelKey = xlErrorHandler
    Const IterationsToUpdate As Integer = 10
    For Each objSubFolder In objFolder.subfolders
        MyArr(i, 1) = objSubFolder.Name
        MyArr(i, 2) = objSubFolder.Path
        i = i + 1
            MyArr = Application.Transpose(MyArr)
            ReDim Preserve MyArr(1 To 2, 1 To i)
            MyArr = Application.Transpose(MyArr)
        If i Mod IterationsToUpdate = 0 Then
            Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name
            DoEvents
        End If
    Next objSubFolder
    Application.StatusBar = ""

    wsOutput.Rows("2:1048576").Delete
    Dim Destination As Range
    Set Destination = wsOutput.Range("A2")
    Destination.Resize(UBound(MyArr, 1), UBound(MyArr, 2)).Value = MyArr
    wsOutput.Columns.EntireColumn.AutoFit: wsOutput.UsedRange.HorizontalAlignment = xlCenter
    wsOutput.Activate

    MsgBox ("Done")

CleanExit:
    Application.StatusBar = False
    Application.StatusBar = ""
    Application.Cursor = xlDefault
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Exit Sub

CleanFail:
    Const MsgTitle As String = "Operation not completed"
    If Err.Number = 18 Then
        MsgBox "Operation was cancelled.", vbInformation, MsgTitle
    Else
        MsgBox "An error has occurred: " & Err.Description, vbCritical, MsgTitle
    End If
    Resume CleanExit

End Sub

Get Folder Names from server directory

1 Answers1