Traverse Directory

[erock24]

I ran into some code out there and with a little edit created a very useful macro that will run through the directory and traverse all sub directories.

Sub TraverseConversion()
    Run ("C:\Project Request Forms - Operating & Capital\Convert Forms\")
End Sub

Sub Run(ByVal location As String)
    Dim aSubDir() As String
    Dim count As Integer
    Dim sSubDir As String
    ReDim aSubDir(0)
    count = 0
    
    sSubDir = Dir(location, vbDirectory)
    Do While sSubDir <> ""
        sSubDir = Dir
        If InStr(1, sSubDir, ".") = 0 And sSubDir <> "" Then
        ReDim Preserve aSubDir(count)
        aSubDir(count) = location & sSubDir & "\"
        count = count + 1
        End If
    Loop
    Do While count <> 0
        count = count - 1
        Run (aSubDir(count))
    Loop
    AutoConversion (location)
End Sub

Sub AutoConversion(ByVal y As String)

Dim myReturn&
myReturn = MsgBox("Are You Sure You Want to Start Auto-Conversions?", _
                    vbInformation + vbYesNo, _
                    "Convert Old Forms?")
If myReturn = 6 Then GoTo YesConvert
If myReturn = 7 Then Exit Sub

YesConvert:
Dim NewWb As Workbook
Set NewWb = ActiveWorkbook

    Dim YourDirectory As String
    Dim YourFileType As String
    Dim LoadDirFileList As Variant
    Dim ActiveFile As String
    Dim FileCounter As Integer
    Dim OldWb As Workbook
    Dim strFileName As String
    Dim formtitle As Variant
         
    YourDirectory = y ' Folder containing files
    YourFileType = "xls"
    
    LoadDirFileList = GetFileList(YourDirectory)
    If IsArray(LoadDirFileList) = False Then
         MsgBox "No files found"
        Exit Sub
    Else
         ' Loop around each file in your directory
        For FileCounter = LBound(LoadDirFileList) To UBound(LoadDirFileList)
            ActiveFile = LoadDirFileList(FileCounter)
            Debug.Print ActiveFile
            If Right(ActiveFile, 3) = YourFileType Then
                Set OldWb = Application.Workbooks.Open(YourDirectory & ActiveFile)
                Application.EnableEvents = False
                Application.DisplayAlerts = False

'With Each File do....

                Set OldWb = Nothing
            End If
        Next FileCounter
    End If
End Sub
Function GetFileList(FileSpec As String) As Variant
     ' Returns an  array of filenames that match FileSpec. If no matching files are found, it returns False
    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String
     
    On Error GoTo NoFilesFound
    FileCount = 0
    FileName = Dir(FileSpec, vbNormal)
    If FileName = "" Then GoTo NoFilesFound
     
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function
NoFilesFound:
    GetFileList = False
End Function