Function getDirList(startDir As String)
Dim foundDirs()
Dim subDir As String
Dim dirCount As Integer
subDir = Dir(startDir, vbDirectory + vbHidden)
Do While subDir <> ""
If subDir <> "." And subDir <> ".." Then
If (GetAttr(startDir & subDir) And vbDirectory) = vbDirectory Then
dirCount = dirCount + 1
ReDim Preserve foundDirs(dirCount)
foundDirs(dirCount) = startDir & subDir & "\"
End If
End If
subDir = Dir
Loop
If dirCount = 0 Then
getDirList = False
Else
getDirList = foundDirs
End If
End Function
Private Sub Form_Open(Cancel As Integer)
Call Old_Form_Open("x:\dbases_AC\dbases\")
End Sub
Sub Old_Form_Open(strPath As String)
Dim strFile As String
Dim varDirs As Variant
Dim i As Integer
CurrentDb.Execute "DELETE * FROM tblTables"
strFile = Dir(strPath & "*.mdb")
varDirs = getDirList(strPath)
While strFile <> ""
CurrentDb.Execute "INSERT INTO tblTables (TableName, DatabaseName) SELECT Name,'" & strPath & strFile & "' FROM MSysObjects IN '" & strPath & strFile & "' WHERE Name = 'employees'"
strFile = Dir()
Wend
If IsArray(varDirs) Then
For i = 1 To UBound(varDirs)
Call Old_Form_Open(varDirs(i))
Next i
End If
Me!Combo0.Requery
End Sub