When I’m designing a database I usually start off with one of my Templates. But, as with any Template, the Tables therein do not always fit exactly with the Client’s needs. And, since I like to document changes I built this tool…
In a nutshell…
After the Template database is created I import the Objects from the Tables and File List database. From there I can go to Design Mode of the Table, the little blue button, and make my changes, as well as, mark what changes I’ve made in the *Comments* column. Then I have a record of my changes and, just in case someone needs a hard copy, output the results to Excel (template included).
To use…
Download the Table and File List zipped file and unzip the contents to a Folder, not your Desktop. Then open the database you want to run this on and import the Objects into your database and place TableFieldList.xlsx into the same Folder as the database you want to use this in. Open frmTableFileList and click the Redo Command Button.
The blue button to the left opens the Table in Design Mode. (Thanks to Tony Toews’ database for giving me the idea to go directly to Design Mode from here instead to dealing with the Navigation Pane.)
I use the Check Box to indicate I cam done. Once checked the record (row) will turn light grey (helps me stay focused).
Blue boxes at the top are for filtering. Once making a selection and/or entering text, partial entries accepted, select the Filter button at the top, to clear select the Clear Filter button.
The code (in case your interested)…
Pretty standard except that it loops thru the Tables in MSysObjects so it does not require the individual input of each Table run. Nor do you need to create tblTableFieldList before running as it will look to see if it’s there. (One caveat, I did not adjust the Form to run without the query which needs the Table, never got around to it. So, if you attempt to open the Form before creating the Table you will get a message. However, in the sample provided there is a Table so no worries there.)
Function fncTableFieldList() '7.15.2016 Gina Whipp (Access Diva) 'Purpose: Write all table and field names to tblTableFieldList Dim lngTable As Long Dim lngField As Long Dim db As DAO.Database Dim rs As DAO.Recordset Dim tdf As DAO.TableDef Dim lngRow As Long Dim fld As DAO.Field Dim strTable As String Set db = CurrentDb strTable = "tblTableFieldList" If DCount("*", "MSysObjects", "Type = 1 AND Name='" & strTable & "'") = 0 Then 'Create tblTableFieldList Set tdf = db.CreateTableDef("tblTableFieldList") With tdf 'Autonumber Set fld = .CreateField("tflID", dbLong) fld.Attributes = dbAutoIncrField + dbFixedField .Fields.Append fld .Fields.Append .CreateField("tflTableName", dbText, 50) .Fields.Append .CreateField("tflFieldName", dbText, 50) .Fields.Append .CreateField("tflDataTypeID", dbLong) .Fields.Append .CreateField("tflSize", dbLong) .Fields.Append .CreateField("tflAttributeID", dbLong) .Fields.Append .CreateField("tflComment", dbText, 255) .Fields.Append .CreateField("tflExclude", dbBoolean) End With 'Append new output table definition to database db.TableDefs.Append tdf Set fld = Nothing Set tdf = Nothing 'Debug.Print "tblTableFieldList created." Application.RefreshDatabaseWindow Else 'Empty tblTableFieldList strSQL = "DELETE tblTableFieldList.* FROM tblTableFieldList" CurrentDb.Execute strSQL, dbFailOnError 'Debug.Print "tblTableFieldList emptied." End If Set rs = db.OpenRecordset("tblTableFieldList", dbOpenDynaset) 'Set on error in case there is no tables On Error Resume Next 'Loop through all tables For lngTable = 0 To db.TableDefs.Count 'Ignore temporary (~) and system tables (MSys) If Left(db.TableDefs(lngTable).Name, 1) = "~" Or _ Left(db.TableDefs(lngTable).Name, 4) = "MSys" Then Else 'Otherwise, loop through each table and get Primary Key For lngField = 0 To db.TableDefs(lngTable).Fields.Count - 1 'Use this if you don't want Primary Key 'For lngField = 1 To db.TableDefs(lngTable).Fields.Count - 1 lngRow = lngRow + 1 rs.AddNew rs!tflTableName = db.TableDefs(lngTable).Name rs!tflFieldName = db.TableDefs(lngTable).Fields(lngField).Name rs!tflDataTypeID = db.TableDefs(lngTable).Fields(lngField).Type rs!tflSize = db.TableDefs(lngTable).Fields(lngField).Size rs!tflAttributeID = db.TableDefs(lngTable).Fields(lngField).Attributes rs.Update Next lngField End If Next lngTable 'Resume error breaks On Error GoTo 0 'Release from memory Set rs = Nothing Set db = Nothing End Function
Enjoy!
1,499 total views, 2 views today