Export Query and Table structure details from Access using VBA

Using Excel VBA and Microsoft SQL Server As Reporting Enhancement: A Prototype Of Financial Reporting ApplicationI 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