I am busy migrating an Access system, and documenting, so I need a way to document the SQL Queries and Table details. After initially trying to get Access's documentation tool to give me what I needed, I started looking for alternatives.
The below code is partly mine and based on the websites mentioned in the comments. Essentially it exports Query and Table information into 3 files in the tmp directory. I tried to do the SQL queries using CSV but even using "'" and """ did not work, so change it to TABS.
This means that you can get most of the details for structures in a usable format (not like the Database Documenter which provides unusable details)
so here is the code that I ended up with, thought I would share it:
Public Sub GetQrysAndTbls()
' Using a few items found on the internet write query and table definitions
' to a text file including field detail for tables
' Original posts found at:
' http://www.techrepublic.com/article/how-to-create-a-list-of-tables-or-queries-from-access/5047664
' http://forums.techguy.org/business-applications/526520-solved-getting-field-names-tables.html
' http://www.everythingaccess.com/tutorials.asp?ID=Dump-table-details-in-VBA-(DAO)
' http://www.access-programmers.co.uk/forums/showthread.php?t=28219
Dim db As Database
Dim Qry As QueryDef
Dim QryCount As Integer
Dim Tbl As TableDef
Dim TblCount As Integer
Dim fso, TxtFile
' initialize variables
Set db = CurrentDb
QryCount = 0
TblCount = 0
' First the Querys, use txt file since "," 's mess up in CSV
Set fso = CreateObject("Scripting.FileSystemObject")
Set TxtFile = fso.CreateTextFile("c:\tmp\QryDefs.txt", True)
TxtFile.writeline ("Query name" & vbTab & "SQL String")
For Each Qry In db.QueryDefs
' erase any CrLf, could also add a "," instead also make sure that the query is a string
TxtFile.writeline (Qry.Name & vbTab & Replace(Qry.SQL, vbCrLf, ""))
QryCount = QryCount + 1
Next
TxtFile.Close
' Now the Tables and Field definitions
Set TxtFile = fso.CreateTextFile("c:\tmp\TableDefs.csv", True)
' Put the header line in place
TxtFile.writeline ("Table Name:,Fields: Field Name,Field Type,Size,Required,Default,Description")
For Each Tbl In db.TableDefs
If Tbl.Attributes = 0 Then 'Ignores System Tables
' place the table name in the first line,
TxtFile.write (Tbl.Name)
' write the fields leaving space at the front of each for formatting purposes
For Each fld In Tbl.Fields
TxtFile.writeline ("," & fld.Name & "," & FieldTypeName(fld) & "," & fld.Size & "," & _
IIf(CBool(fld.Required), "True", "False") & "," & CStr(fld.DefaultValue) & "," & GetDescrip(fld))
Next
TblCount = TblCount + 1
End If
Next
TxtFile.Close
' Now the Tables and Index definitions
Set TxtFile = fso.CreateTextFile("c:\tmp\TableIndexs.csv", True)
' Put the header line in place
TxtFile.writeline ("Table Name:,Indexes: Name,Primary,Unique,NoNulls,Fields")
For Each Tbl In db.TableDefs
If Tbl.Attributes = 0 Then 'Ignores System Tables
' place the table name in the first line,
TxtFile.write (Tbl.Name)
' write the fields leaving space at the front of each for formatting purposes
For Each idx In Tbl.Indexes
TxtFile.write ("," & idx.Name & "," & idx.Primary & "," & idx.Unique & "," & idx.IgnoreNulls)
' Now write the fields
For Each fld In idx.Fields
TxtFile.write ("," & fld.Name)
Next
TxtFile.writeline ("")
Next
End If
Next
TxtFile.Close
MsgBox "Wrote: " & Str$(QryCount) & " Queries, and " & Str$(TblCount) & " table definiations to file."
' close the files and db
db.Close
Set db = Nothing
End Sub
Function GetDescrip(ByVal obj As Object) As String
On Error Resume Next
GetDescrip = obj.Properties("Description")
End Function
Function FieldTypeName(ByVal fld As DAO.Field) As String
'Purpose: Converts the numeric results of DAO Field.Type to text.
Dim strReturn As String 'Name to return
Select Case CLng(fld.Type) 'fld.Type is Integer, but constants are Long.
Case dbBoolean: strReturn = "Yes/No" ' 1
Case dbByte: strReturn = "Byte" ' 2
Case dbInteger: strReturn = "Integer" ' 3
Case dbLong ' 4
If (fld.Attributes And dbAutoIncrField) = 0& Then
strReturn = "Long Integer"
Else
strReturn = "AutoNumber"
End If
Case dbCurrency: strReturn = "Currency" ' 5
Case dbSingle: strReturn = "Single" ' 6
Case dbDouble: strReturn = "Double" ' 7
Case dbDate: strReturn = "Date/Time" ' 8
Case dbBinary: strReturn = "Binary" ' 9 (no interface)
Case dbText '10
If (fld.Attributes And dbFixedField) = 0& Then
strReturn = "Text"
Else
strReturn = "Text (fixed width)" '(no interface)
End If
Case dbLongBinary: strReturn = "OLE Object" '11
Case dbMemo '12
If (fld.Attributes And dbHyperlinkField) = 0& Then
strReturn = "Memo"
Else
strReturn = "Hyperlink"
End If
Case dbGUID: strReturn = "GUID" '15
'Attached tables only: cannot create these in JET.
Case dbBigInt: strReturn = "Big Integer" '16
Case dbVarBinary: strReturn = "VarBinary" '17
Case dbChar: strReturn = "Char" '18
Case dbNumeric: strReturn = "Numeric" '19
Case dbDecimal: strReturn = "Decimal" '20
Case dbFloat: strReturn = "Float" '21
Case dbTime: strReturn = "Time" '22
Case dbTimeStamp: strReturn = "Time Stamp" '23
'Constants for complex types don't work prior to Access 2007.
Case 101&: strReturn = "Attachment" 'dbAttachment
Case 102&: strReturn = "Complex Byte" 'dbComplexByte
Case 103&: strReturn = "Complex Integer" 'dbComplexInteger
Case 104&: strReturn = "Complex Long" 'dbComplexLong
Case 105&: strReturn = "Complex Single" 'dbComplexSingle
Case 106&: strReturn = "Complex Double" 'dbComplexDouble
Case 107&: strReturn = "Complex GUID" 'dbComplexGUID
Case 108&: strReturn = "Complex Decimal" 'dbComplexDecimal
Case 109&: strReturn = "Complex Text" 'dbComplexText
Case Else: strReturn = "Field type " & fld.Type & " unknown"
End Select
FieldTypeName = strReturn
End Function
:
Comments