Printing table names and unused fields 2

[tobymom]

I have many tables with many unused fields(which don't have any data on it due to poor db planning)

I want to use VB code to print the list so that I can show it to my manager to convince him that our DB table needs restructuring.

Could you give me some pointers?

for all tables on this db
print table name
go to first table
for this table
go to first field
check if the field is used or not
if field is empty (no data)
print its name
end if
go to next field
end for this table
go to next table
end for all tables on this db


thank you in advance...

 

[jrbarnett]

Untested, here goes as a start:

Paste into module, save it, type ?CheckTablesForEmptyData from the immediate window. You will need a reference to the Microsoft DAO 3.6 Object library for this to work.

Public Function CheckTablesForEmptyData
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field

Dim lngTableRecCount As Long
Dim lngFldRecCount As Long

Set db = CurrentDb

For Each tdf In db.TableDefs
  Debug.Print "Table: " & tdf.Name
  Debug.Print
  lngTableRecCount = DCount ("*", tdf.Name)
  If lngTableRecCount = 0 Then Debug.Print " ** Table Has No Records In It ** "

  For Each fld In tdf.Fields
    Debug.Print "  Field: " & fld.Name
    lngFldRecCount = DCount ("*", tdf.name, "fld.name is not null")
    if lngFldRecCount = 0 Then Debug.Print "Field Has No Data In It" Else Debug.Print "Field has data for " & lngFldRecCount/lngTableRecCount*100 "% total records"
  Next fld
Next tdf

Set db = Nothing

End Function

 

[MichaelRed]

Somewhat more elaborate, but not substantially different/better - except briefly tested:

This ver uses a table to hold the results. The second "code block" lists an approximate def of the table fields. A-La MR. jrbarnett, it requires the reference to the DAO record set.

Public Function basTableStats_II()

    Dim dbs As DAO.Database
    Dim rstTables As DAO.Recordset
    Dim rstTableStats As DAO.Recordset
    Dim rstTemp As DAO.Recordset
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim Indx As DAO.index
    Dim IndxObj As Object

    Dim Idx As Integer
    Dim Jdx As Integer
    Dim lngTblCount As Integer

    'Local vars for info to place in table
    Dim lngRecLen As Integer
    Dim lngRecCount As Long
    Dim strSQL As String
    Dim IndxFldName As String
    Dim lngIndxSize As Long
    Dim intFldLen As Integer
    Dim lngFldCount As Long
    Dim strFldName As String

    Set dbs = CurrentDb

    DoCmd.SetWarnings False
        DoCmd.RunSQL "Delete * from tblTableStats_II;"
    DoCmd.SetWarnings True

    strSQL = "SELECT Name, Type " _
           & "From MSysObjects " _
           & "WHERE (((MSysObjects.Name) Not Like " & Chr(34) & "MSys*" & Chr(34) & ") " _
           & "AND ((MSysObjects.Type) = 1 Or (MSysObjects.Type) = 6));"

    Set rstTables = dbs.OpenRecordset(strSQL, dbOpenDynaset)
    Set rstTableStats = dbs.OpenRecordset("tblTableStats_II", dbOpenDynaset)

    While rstTables.EOF = False
        Set tdf = dbs.TableDefs(rstTables!Name)
        If (tdf.Name = "~TMPCLP61221") Then
            GoTo LblSkipTemp
        End If
        Idx = Idx + 1
        lngRecLen = 0
        Set rstTemp = dbs.OpenRecordset(rstTables!Name, dbOpenDynaset)
        If (rstTemp.BOF = True And rstTemp.EOF = True) Then
            lngRecCount = 0
            GoTo LblRecLen
        End If
        rstTemp.MoveLast
        rstTemp.MoveFirst
        lngRecCount = rstTemp.RecordCount

        Set rstTemp = Nothing
LblRecLen:
        lngRecLen = 0
        For Each fld In tdf.Fields      'ALL Fields
            lngRecLen = lngRecLen + fld.Size
        Next fld
        lngIndxSize = 0
        For Each Indx In tdf.Indexes
            Jdx = 0
            While Jdx < Indx.Fields.Count
                IndxFldName = Indx.Fields(Jdx).Name
                lngRecLen = lngRecLen + tdf.Fields(IndxFldName).Size
                lngIndxSize = lngIndxSize + tdf.Fields(IndxFldName).Size
                Jdx = Jdx + 1
            Wend
        Next Indx
        
        Jdx = 0
        While Jdx < tdf.Fields.Count
            strSQL = "Select Count([" & tdf.Fields(Jdx).Name _
                   & "]) As Num " _
                   & "From [" & rstTables!Name & "] " _
                   & "HAVING ((Not (Count([" & rstTables!Name & "].[" _
                   & tdf.Fields(Jdx).Name & "])) Is Null));"
            Set rstTemp = dbs.OpenRecordset(strSQL)
            lngFldCount = rstTemp!Num
            strFldName = tdf.Fields(Jdx).Name
            intFldLen = tdf.Fields(Jdx).Size
            Jdx = Jdx + 1
            With rstTableStats
                .AddNew
                    !tblName = rstTables!Name
                    !tblLocal = (rstTables!Type = 1)
                    !RecCount = lngRecCount
                    !recLen = lngRecLen
                    !TotalSize = lngRecCount * lngRecLen
                    !IndxSize = lngIndxSize
                    !fldName = strFldName
                    !fldLen = intFldLen
                    !fldCount = lngFldCount
                .Update
            End With
        Wend
'''        Debug.Print Idx, tdf.Name, lngRecCount, lngRecLen, lngRecCount * lngRecLen
LblSkipTemp:
        rstTables.MoveNext
    Wend
End Function

Private Sub bastblDef()
    Dim fldDefs(8) As String
    fldDefs(0) = "tblName, Text, Name of Table"
    fldDefs(1) = "tblLocal, Y/N, Local (Embedded) table = True; else false (linked etc)"
    fldDefs(2) = "RecCount, Number of records in the Table"
    fldDefs(3) = "RecLen, Number (Long Integer), Number of Records in the Table"
    fldDefs(4) = "fldName, Number (Long Integer) Name of the Field in the Table"
    fldDefs(5) = "fldCount, Number (Long Integer) Number of records with Some (e.g. No Null) value"
    fldDefs(6) = "indxSize, Number (Long Integer), approximate size of the index fields (collectively)"
    fldDefs(7) = "Total Size, Number (Long Integer) overall size of the Table. Assumes all fields are fully populated"
End Sub

MichaelRed

 

[tobymom]

OMG, you guys are awesome!!!
I really appreciate your time and effort on helping me out on this. I learned alot by studying your codes.

THANK YOU!!!