List Tables and Fields in ODBC Database

[Snailspace]

Hi<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
I’m trying to build a list of tables and their corresponding fields, hopefully using excel (2003) rather than querying each table manually and saving it.<o></o>
The following code (from http://www.vbaexpress.com/kb/getarticle.php?kb_id=707) looks like it would do what I want if I had access, which unfortunately I do not.<o></o>
If anyone could help me tweak this it would be greatly appreciated.<o></o>

Option Compare Database
Option Explicit
Sub ListTablesAndFields()
'Macro Purpose: Write all table and field names to and Excel file
Dim lTbl As Long
Dim lFld As Long
Dim dBase As Database
Dim xlApp As Object
Dim wbExcel As Object
Dim lRow As Long
'Set current database to a variable adn create a new Excel instance
Set dBase = CurrentDb
Set xlApp = CreateObject("Excel.Application")
Set wbExcel = xlApp.workbooks.Add
 
'Set on error in case there is no tables
On Error Resume Next
'Loop through all tables
For lTbl = 0 To dBase.TableDefs.Count
'If the table name is a temporary or system table then ignore it
If Left(dBase.TableDefs(lTbl).Name, 1) = "~" Or _
Left(dBase.TableDefs(lTbl).Name, 4) = "MSYS" Then
'~ indicates a temporary table
'MSYS indicates a system level table
Else
'Otherwise, loop through each table, writing the table and field names
'to the Excel file
For lFld = 1 To dBase.TableDefs(lTbl).Fields.Count - 1
lRow = lRow + 1
With wbExcel.sheets(1)
.range("A" & lRow) = dBase.TableDefs(lTbl).Name
.range("B" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Name
End With
Next lFld
End If
Next lTbl
'Resume error breaks
On Error GoTo 0
'Set Excel to visible and release it from memory
xlApp.Visible = True
Set xlApp = Nothing
Set wbExcel = Nothing
'Release database object from memory
Set dBase = Nothing
 
End Sub

The following is the recorded VBA from querying to show Database name, where ZPROD is the DSN database and ABNFIELD is the first table.

Connection:=”ODBC;DSN=ZPROD;”<o:p></o:p>
“FROM XXX01.ZPROD.ABNFIELD”<o:p></o:p>

<o></o>
<o></o>
<o>Thanks in advance SP</o>

 

[Andrew Poulsom]

Is this any help?

http://www.motobit.com/tips/detpg_listdb/

 

[Snailspace]

Thanks for such a quick reply, I'll try it out.

 

[Snailspace]

I’m afraid I struggle with the connections bit, I’m connecting to iseries via ODBC <?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
I can't figure out which names I put in the conn.provider part , assuming the DSN is "ZPROD" and the Database is "XXX01".
I could be miles off here as I’m only guessing the database is the XXX01 from the recorded query. Though I know that ZPROD is an ODBC connection I can set up queries through (hope that makes sense).<o></o>
Any pointers gladly received as I’m struggling to get my head around this.<o></o>

[FONT=Courier New][FONT=Courier New] Conn.Provider = [COLOR=brown]"MSDASQL"[/COLOR]<o:p></o:p>[/FONT]
[FONT=Courier New] Conn.Open [COLOR=brown]"DSN=...;Database=...;"[/COLOR], [COLOR=brown]"UID"[/COLOR], [COLOR=brown]"PWD"[/COLOR][/FONT]
[/FONT]

 

[Snailspace]

Andrew,
Thank you so much for pointing me in the right direction.
I'm still a long way from understanding how to define connections and things, but the following code seemed to work. This was so much quicker than trying to do a query on each table.
Now all I have to do is figure out what all the field names mean.

Sub ListTablesADO()
  Dim Conn As New ADODB.Connection
  Dim TablesSchema As ADODB.Recordset
  Dim ColumnsSchema As ADODB.Recordset
  Dim R As Long
 
Conn.Open "Driver={Client Access ODBC Driver (32-bit)};System=XXX01;Uid=YYYY;Pwd=password;Library=LLLL;"
  'Get all database tables.
  R = 1
  Set TablesSchema = Conn.OpenSchema(adSchemaTables)
 
  Do While Not TablesSchema.EOF
    'Get all table columns.
    Set ColumnsSchema = Conn.OpenSchema(adSchemaColumns, _
      Array(Empty, Empty, "" & TablesSchema("TABLE_NAME")))
    Do While Not ColumnsSchema.EOF
        Worksheets("Sheet1").Range("A" & R) = TablesSchema("TABLE_NAME")
        Worksheets("Sheet1").Range("B" & R) = ColumnsSchema("COLUMN_NAME")
        R = R + 1
      Debug.Print TablesSchema("TABLE_NAME") & ", " & _
        ColumnsSchema("COLUMN_NAME")
      ColumnsSchema.MoveNext
    Loop
    TablesSchema.MoveNext
  Loop
End Sub