list fields via tableInfo function problem (1 Viewer)

[Kuhn]

Hi all,

I a trying to list all fields from ALL tables in a certain DB.
I am using the tableinfo function. However, because the output of the immediate window is limited to 200 lines, I can only see the last 200 fields.
Is there a way to export this in another way than the debug.print procedure, so I can bypass this limitation?

my code

Public Sub showtablefields()
Dim db As Database
Dim tdl As TableDef

Set db = CurrentDb
For Each tdl In db.TableDefs
   If Left(tdl.Name, 4) <> "MSys" Then ' Don't enumerate the system tables
      TableInfo (tdl.Name)
   End If
Next tdl
End Sub

and the tableinfo function:

Function TableInfo(strTableName As String)
On Error GoTo TableInfoErr
   ' Purpose:   Display the field names, types, sizes and descriptions for a table.
   ' Argument:  Name of a table in the current database.
   Dim db As DAO.Database
   Dim tdf As DAO.TableDef
   Dim fld As DAO.Field
   
   Set db = CurrentDb()
   Set tdf = db.TableDefs(strTableName)
   For Each fld In tdf.Fields
      Debug.Print tdf.Name & ";" & fld.Name & ";" & FieldTypeName(fld) & ";" & fld.Size & ";" & GetDescrip(fld) & ";"
   Next

TableInfoExit:
   Set db = Nothing
   Exit Function
TableInfoErr:
   Select Case Err
   Case 3265&  'Table name invalid
      MsgBox strTableName & " table doesn't exist"
   Case Else
      Debug.Print "TableInfo() Error " & Err & ": " & Error
   End Select
   Resume TableInfoExit
End Function

Function GetDescrip(obj As Object) As String
    On Error Resume Next
    GetDescrip = obj.Properties("Description")
End Function

Function FieldTypeName(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 and later.
        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

 

[pr2-eugin]

You can open a File to Output the info?

Function TableInfo(strTableName As String)
On Error GoTo TableInfoErr
    [COLOR=Green]' Purpose:   Display the field names, types, sizes and descriptions for a table.
    ' Argument:  Name of a table in the current database.[/COLOR]
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field

    Set db = CurrentDb()
    Set tdf = db.TableDefs(strTableName)
   [COLOR=Green] 'Change to suit your needs ![/COLOR]
    Open "[B][COLOR=Blue]D:\someFolder\TableInfo.txt[/COLOR][/B]" For Output As #1
    Print #1, "Last Modified - " & Now()
    Print #1, ""
    For Each fld In tdf.Fields
        Print #1, tdf.Name & ";" & fld.Name & ";" & FieldTypeName(fld) & ";" & fld.Size & ";" & GetDescrip(fld) & ";"
    Next
    Close #1
TableInfoExit:
    Set db = Nothing
    Exit Function
TableInfoErr:
    Select Case Err
    Case 3265&      [COLOR=Green]'Table name invalid[/COLOR]
        MsgBox strTableName & " table doesn't exist"
    Case Else
        Debug.Print "TableInfo() Error " & Err & ": " & Error
    End Select
    Resume TableInfoExit
End Function

 

[Kuhn]

thanks! however this overwrites the same TXT file over and over (leaving me with just the info from the last table). Tried to transfer that code to the first part, but no success.

 

[pr2-eugin]

Okay sorry my bad.. Try..

Public Sub showtablefields()
    Dim db As Database
    Dim tdl As TableDef
    Set db = CurrentDb
    [COLOR=Green]'Change to suit your needs ![/COLOR]
[COLOR=Blue][B]    Open "D:\someFolder\TableInfo.txt" For Output As #1
    Print #1, "Last Modified - " & Now()
    Print #1, ""[/B][/COLOR]
    For Each tdl In db.TableDefs
        If Left(tdl.Name, 4) <> "MSys" Then ' Don't enumerate the system tables
            [COLOR=Blue][B]Print #1,[/B][/COLOR] TableInfo(tdl.Name)
        End If
    Next tdl
    [COLOR=Blue][B]Close #1[/B][/COLOR]
End Sub


Function TableInfo(strTableName As String)[COLOR=Red][B] As String[/B][/COLOR]
On Error GoTo TableInfoErr
    [COLOR=Green]' Purpose:   Display the field names, types, sizes and descriptions for a table.
    ' Argument:  Name of a table in the current database.[/COLOR]
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    [COLOR=Red][B]Dim retStr As String[/B][/COLOR]

    Set db = CurrentDb()
    Set tdf = db.TableDefs(strTableName)
    
    For Each fld In tdf.Fields
        [COLOR=Red][B]retStr = retStr &[/B][/COLOR] tdf.Name & ";" & fld.Name & ";" & FieldTypeName(fld) & ";" & fld.Size & ";" & GetDescrip(fld) & ";" [COLOR=Red][B]& vbCrLf[/B][/COLOR]
    Next
    [COLOR=Red][B]TableInfo = retStr[/B][/COLOR]
TableInfoExit:
    Set db = Nothing
    Exit Function
TableInfoErr:
    Select Case Err
    Case 3265&      'Table name invalid
        MsgBox strTableName & " table doesn't exist"
    Case Else
        Debug.Print "TableInfo() Error " & Err & ": " & Error
    End Select
    Resume TableInfoExit
End Function

 

[Kuhn]

fantastic - thanks a lot ! you just saved me hours of pointless work

 

[pr2-eugin]

Happy to help ! Good Luck !