Dir Listing

Uses a Do loop to stop VBA processing until the output file has been created.

Public Sub fncUpdateDirs()
''Public function fncUpdateDirs() As Boolean
Dim strBase As String
Dim strDirectoryList As String
Dim strData As String
Dim strFile As String
Dim lStr_Dir As String

''On Error GoTo Err_Handler

    ''lStr_Dir = ThisWorkbook.Path
    lStr_Dir = "C:\Byg\PET\Test"
    
    '' ANW  07-Feb-2003 :
    strDirectoryList = lStr_Dir & "\Directory"

    'Delete completion file
    If Dir(strDirectoryList & ".out") <> "" Then Kill (strDirectoryList & ".out")
    
    'Create Batch program to refresh Dirs
    Open strDirectoryList & ".bat" For Output As #1
    Print #1, "DIR /AD /B /S " & strBase & " > " & strDirectoryList & ".txt"
    Print #1, "Echo ""Complete"" > " & strDirectoryList & ".out"
    Close #1
    'Invoke Directory List generator
    Shell (strDirectoryList & ".bat"), vbMinimizedNoFocus
    'Wait for completion
    Do While Dir(strDirectoryList & ".out") = ""
        DoEvents
    Loop
    
    'Read in Directories and update tblDirectory
    Open strDirectoryList & ".txt" For Input As #2
    Do Until EOF(2)
        strData = ""
        Input #2, strData
        Debug.Print strData
        
        strFile = Dir(strData & "\*.XLS")
        Debug.Print strFile
        Do Until strFile = ""
            strFile = Dir()
            Debug.Print strFile
        Loop
    
    Loop
    Close #2
    
    'Clean up files
    If Dir(strDirectoryList & ".bat") <> "" Then Kill (strDirectoryList & ".bat")
    If Dir(strDirectoryList & ".out") <> "" Then Kill (strDirectoryList & ".out")
    If Dir(strDirectoryList & ".txt") <> "" Then Kill (strDirectoryList & ".txt")

bye:

Exit Sub

Err_Handler:
MsgBox "Error : " & Err.Number & vbCrLf & "Description : " & Err.Description, vbCritical
Resume bye

End Sub