Const ResultTableName As String = "tab_NotUsedColumns"
'Start this:
Private Sub SearchNotUsedDataFieldsInAllTables()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim TargetRs As DAO.Recordset
Set db = CurrentDb
If ResultTableExists(db) Then
db.Execute "delete from " & ResultTableName
Else
CreateResultTable db
End If
Set TargetRs = db.OpenRecordset(ResultTableName, DAO.RecordsetTypeEnum.dbOpenDynaset, dbAppendOnly)
For Each tdf In db.TableDefs
SearchInTable db, tdf, TargetRs
Next
TargetRs.Close
End Sub
Private Sub SearchInTable(db As DAO.Database, ByVal tdf As DAO.TableDef, ByVal TargetRs As DAO.Recordset)
Const FieldNamePrefix As String = "fld"
Dim fld As DAO.Field
Dim SqlText As String
Dim rs As DAO.Recordset
For Each fld In tdf.Fields
SqlText = SqlText & ", " & CreateFieldSqlString(fld.Name, FieldNamePrefix)
Next
SqlText = Mid(SqlText, 3)
SqlText = "select " & SqlText & _
" from [" & tdf.Name & "] as T" & _
" having count(1) > 0"
Set rs = db.OpenRecordset(SqlText, DAO.RecordsetTypeEnum.dbOpenForwardOnly)
If Not rs.EOF Then
CheckRecordsetFields rs, TargetRs, tdf.Name, FieldNamePrefix
End If
rs.Close
End Sub
Private Function CreateFieldSqlString(ByVal FldName As String, FieldNamePrefix As String) As String
CreateFieldSqlString = "Count([" & FldName & "]) as [" & FieldNamePrefix & FldName & "]"
' FieldNamePrefix .. to prevent error with reserved words as alias
End Function
Private Sub CheckRecordsetFields(ByVal rs As DAO.Recordset, ByVal TargetRs As DAO.Recordset, ByVal TabName As String, ByVal FieldNamePrefix As String)
Dim fld As DAO.Field
Dim TabNameTargetFld As DAO.Field
Dim DataFieldNameTargetFld As DAO.Field
Set TabNameTargetFld = TargetRs.Fields("TableName")
Set DataFieldNameTargetFld = TargetRs.Fields("DataFieldName")
For Each fld In rs.Fields
If fld.Value = 0 Then
TargetRs.AddNew
TabNameTargetFld.Value = TabName
DataFieldNameTargetFld.Value = Mid(fld.Name, Len(FieldNamePrefix) + 1)
TargetRs.Update
End If
Next
End Sub
Private Function ResultTableExists(db As DAO.Database) As Boolean
Dim tdf As DAO.TableDef
For Each tdf In db.TableDefs
If tdf.Name = ResultTableName Then
ResultTableExists = True
Exit Function
End If
Next
ResultTableExists = False
End Function
Private Sub CreateResultTable(db As DAO.Database)
db.Execute "create table " & ResultTableName & " (TableName varchar(255) not null, DataFieldName varchar(255) not null, CONSTRAINT PK_" & ResultTableName & " PRIMARY KEY (TableName, DataFieldName))", dbFailOnError
Application.RefreshDatabaseWindow
End Sub
