[AccessD] Count of Table's Records Viewed in Database Window

Don't know if this is of use to any one?

Max


 *Public Sub psAddTableDescription()
' this will add the current total of records in the table as a Description
on the Table which can
' then be viewed in the Database Window
' Max Sherman June 2009. Feel free to do what you want with it.
' I use a similar procedure to allow users to put their own comments onto
Reports which they can
' then use to remember whatever it is they want to remember.  All reports
are shown in a Form which
' the users can select from (filtered by function) with their own
description alongside.
' It then occured to me that I could use this to put the Record Count in the
Description column of the
' tables in the Database Window.*

*    On Error GoTo errhandler
    DoCmd.Hourglass True
    Dim dbs As DAO.Database
    Dim tbl As DAO.TableDef, rst As DAO.Recordset, rstCt As Long
    Dim cnt As DAO.Container, Doc As DAO.Document
    Dim strCon As String, strDesc As String, strDoc As String, strValue As
String
    Set dbs = CurrentDb
    strCon = "Tables"
    strDesc = "Description"
    For Each tbl In CurrentDb.TableDefs
        strDoc = tbl.Name
        If Left(strDoc, 4) = "msys" Then
            'ignore
        Else
            Set rst = CurrentDb.OpenRecordset(strDoc)
            If Not rst.EOF Then
                rst.MoveLast
                rstCt = rst.RecordCount
            Else
                rstCt = 0
            End If
            strValue = "Recs: " & Format(rstCt, "#,0")
            Set rst = Nothing
            Set cnt = dbs.Containers(strCon)
            Set Doc = cnt(strDoc)
            Doc.Properties.Refresh
            Doc.Properties(strDesc) = strValue
        End If
    Next tbl
    DoCmd.Hourglass False
    MsgBox "Done"
exithere:
    Set dbs = Nothing: Set rst = Nothing: Set cnt = Nothing: Set Doc =
Nothing
    Exit Sub
errhandler:
    Select Case Err.Number
    Case 3270  ' property not defined, so create it
        Call sCreateDocProperty(strCon, strDoc, strDesc, strValue,
strType:=dbText)
        Resume Next
    Case Else
        MsgBox "Error in psAddTableDescription: " & Err.Number & vbCrLf &
Err.Description
    End Select
    Resume Next    'exithere
End Sub
Public Sub sCreateDocProperty(strCon, strDoc, strDesc, strValue, strType)
    On Error GoTo exithere
    Dim dbs As DAO.Database, cnt As DAO.Container, Doc As DAO.Document, prp
As DAO.Property
    Set dbs = CurrentDb
    Set cnt = dbs.Containers(strCon)
    Set Doc = cnt(strDoc)
    Set prp = dbs.CreateProperty(strDesc, strType, strValue)
    Doc.Properties.Append prp
exithere:
    Set dbs = Nothing: Set cnt = Nothing: Set Doc = Nothing: Set prp =
Nothing
    Exit Sub
End Sub*

**