Как определить список таблиц в MS Access и как узнать какая таблица активна? - VB

Function ListTablesADO(ByVal dbConn As ADODB.Connection, ByRef myTables() As String, _
                       ByRef myFields() As String) As String
    ' ***
    ' *** Функция возвращает: через массивы, переданные по ссылке, - список таблиц и
    ' *** список полей в каждой таблице, через себя - пустую строку или же текст ошибки.
    ' *** На вход функция получает ОТКРЫТОЕ подключение к источнику данных (ADODB).
    ' ***
    
    Dim TablesSchema As ADODB.Recordset
    Dim ColumnsSchema As ADODB.Recordset
    Dim i As Integer, j As Integer, k As Integer, m As Integer, mem As Integer
    
    Dim tmpTables(1 To 100)
    Dim tmpFields(1 To 100, 1 To 10000)
    i = 0
    mem = 0
    
    On Error GoTo ErrorHandler
    
    ' Выбираем все таблицы:
    Set TablesSchema = dbConn.OpenSchema(adSchemaTables)
    
    Do While Not TablesSchema.EOF
        
        ' Выбираем все поля:
        Set ColumnsSchema = dbConn.OpenSchema(adSchemaColumns, _
                            Array(Empty, Empty, '' & TablesSchema('TABLE_NAME')))
        
        If ColumnsSchema.EOF Then
            ' это системная таблица
            If Check1.Value = 0 Then
                ' не игнорируем системные таблицы - должны вывести их тоже:
                i = i + 1
                tmpTables(i) = TablesSchema('TABLE_NAME')
                tmpFields(i, 1) = 'Это системная таблица'
            End If
        Else
            ' это обычная таблица
            i = i + 1
        End If
        
        Do While Not ColumnsSchema.EOF
            If ColumnsSchema('COLUMN_NAME') <> '' Then
                j = j + 1
                tmpTables(i) = TablesSchema('TABLE_NAME')
                tmpFields(i, j) = ColumnsSchema('COLUMN_NAME')
            End If
            ColumnsSchema.MoveNext
        Loop
        
        TablesSchema.MoveNext
        If j > mem Then mem = j
        j = 0
        
    Loop
    
    ListTablesADO = ''
    If i > 0 Then
        ReDim myTables(1 To i)
        ReDim myFields(1 To i, 1 To mem)
        For k = 1 To i
            For m = 1 To mem
                myTables(k) = tmpTables(k)
                myFields(k, m) = tmpFields(k, m)
            Next m
        Next k
    Else
        ReDim myTables(0 To 0)
        ReDim myFields(0 To 0, 0 To 0)
    End If
    
    On Error GoTo 0
    Exit Function
    
ErrorHandler:
    ListTablesADO = Err.Description
End Function