TopPicLogo TopPicText

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

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

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


Назад ToTop
L.E. 25.12.2012
Рейтинг@Mail.ru