Aantal records in een tabel worden getoond in de description

[Guus2005]

Ik heb een routine gemaakt waarmee je in de description van een tabel kan zien hoeveel records er in de tabel zitten. De bestaande description komt daarachter.
De routine moet wel iedere keer worden gerund op het moment dat je de actuele stand wilt weten.
Leek me makkelijk.

Voor:
Table1 Dummy Tabel
Table2

Na:
Table1 (30) Dummy Tabel
Table2 (430)

Laat me weten wat je ervan vindt.
Doe er je voordeel mee.

Weest gegroet,
Guus

 

[Guus2005]

Door het aantal records te formatteren kan je nu in je database window de tabellen sorteren op de hoeveelheid records. De code die vervangen moet worden:

Public Function SetAantalRecordsPerTable(Optional blnRemove As Boolean = False, Optional blnNumberFormatted As Boolean = False)
    
    Dim i                   As Long
    Dim dbs                 As Database
    Dim hrg                 As New clsHourglass
    Dim myTable             As TableDef
    Dim lngRecords          As String
    Dim strRecords          As String
    Dim strTableName        As String
    Dim strDescription      As String
    Dim intAantalTables     As Integer
    
    On Error GoTo Err_SetAantalRecordsPerTable

    hrg.HourGlassOn

    Set dbs = CurrentDb

    intAantalTables = dbs.TableDefs.Count
    
    SysCmd acSysCmdInitMeter, "Calculating tables ", intAantalTables
    
    'check if tables are connected
    For i = 0 To intAantalTables - 1
        SysCmd acSysCmdUpdateMeter, i
        
        Set myTable = dbs.TableDefs(i)
        strTableName = myTable.Name

        lngRecords = DCount("*", strTableName)

        strDescription = SuppressPreviousRecords(myTable.Properties("Description").Value)
        
        If blnRemove Then
            SetProperty myTable, "Description", strDescription
        ElseIf blnNumberFormatted Then
            strRecords = Format(lngRecords, "00000#")
            SetProperty myTable, "Description", "(" & strRecords & ") " & strDescription
        Else
            SetProperty myTable, "Description", "(" & lngRecords & ") " & strDescription
        End If
    Next

Exit_SetAantalRecordsPerTable:
    SysCmd acSysCmdRemoveMeter
    Exit Function

Err_SetAantalRecordsPerTable:
    Select Case Err.Number
    Case 3270:  'Missing description property
        SetProperty myTable, "Description", strDescription
        Resume Next
    Case 3385: strDescription = " " & strDescription: Resume
    Case Else
        MsgBox Err.Description, vbCritical
    End Select
    Resume Exit_SetAantalRecordsPerTable
    Resume

End Function

Gesorteerd op omschrijving
Table3 (0) Lege tabel
Table1 (20) Zomaar een tabel
Table2 (4) Practisch lege tabel

wordt nu:
Table3 (000000) Lege tabel
Table2 (000004) Practisch lege tabel
Table1 (000020) Zomaar een tabel

Doe er je voordeel mee!