Количество записей в таблицах БД

Бывает - откроешь чужую базу, а там таблиц под сотню и все с "весёлыми" названиями.
Перебирать все лень и долго ...
Данное решение создаёт таблицу количества записей в таблицах базы данных.
- спасёт когда примерное кол-во записей известно, а название таблицы нет.

Private Sub CountRecordsInTables()

'es - 12.11.2012

'Создаёт таблицу количества записей в таблицах базы данных

'--------------------------------------------------------------------

Const strTableName As String = "00TempRecordsInTables"

Dim tbl As TableDef 'объект таблица

Dim idx As Index 'объект индекс

Dim fld As Field 'объект поле

Dim l As Long

Dim strSQL As String

'--------------------------------------------------------------------

'Создание объектной переменной таблицы, полей и индекса в ней

On Error GoTo CountRecordsInTables_Err

Set tbl = CurrentDb.CreateTableDef(strTableName)

With tbl

.Fields.Append tbl.CreateField("tblName", dbText, 250)

.Fields.Append tbl.CreateField("tblRecords", dbLong)

'создание уникального индекса

Set idx = .CreateIndex("Primary Key")

With idx

'добавление поля в индекс

.Fields.Append .CreateField("tblName")

'Установка свойств индекса

.Unique = True 'Уникальный

.Primary = True 'Первичный

End With

.Indexes.Append idx

'индекс создан

End With

'Фактическое добавление таблицы из объектной переменной описанной выше

CurrentDb.TableDefs.Append tbl

Set idx = Nothing

Set tbl = Nothing

'--------------------------------------------------------------------

'Заполнение таблицы данными (Название таблицы + кол-во записей)

For Each tbl In CurrentDb.TableDefs

If (tbl.Attributes And dbSystemObject) = False Then

l = tbl.RecordCount

'Конструируем запрс

strSQL = "INSERT INTO " & strTableName & " (tblName, tblRecords) VALUES ('" & tbl.Name & "', " & l & ")"

'Выполняем запрос = Добавляем запись

CurrentDb.Execute strSQL

End If

Next

CountRecordsInTables_Bye:

Exit Sub

CountRecordsInTables_Err:

MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _

"in procedure CountRecordsInTables", vbCritical, "Error!"

Resume CountRecordsInTables_Bye

End Sub