PDA

View Full Version : Extract Access Table Names



lifeson
05-01-2007, 02:15 AM
Is there any code available to extract and create a list of table names from an access database?
I ideally want to be able to create a list of all tables from the database and the user can select to import all the active records from the table selected into a spreadsheet. Some of the tables though contain more than the 65000 row limit so probably need some error handling as well

Thanks in advance

Bob Phillips
05-01-2007, 02:25 AM
Sub GetTables()
Dim oConn As Object
Const sFilename As String = "C:\program files\Microsoft Office 97\Office\Samples\NORTHWIND.mdb"
Dim oCat As Object 'ADOX.Catalog
Dim tbl As Object 'ADOX.Table
Dim iRow As Long
Dim sConnString As String
Dim sTableName As String
Dim cLength As Integer
Dim iTestPos As Integer
Dim iStartpos As Integer
Dim sTables As String

sConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
sFilename

Set oConn = CreateObject("ADODB.Connection")
oConn.Open sConnString
Set oCat = CreateObject("ADOX.Catalog")
Set oCat.ActiveConnection = oConn

iRow = 1
For Each tbl In oCat.Tables
If (tbl.Type <> "ACCESS TABLE" And _
tbl.Type <> "SYSTEM TABLE") Then
sTableName = tbl.Name
cLength = Len(sTableName)
iTestPos = 0
iStartpos = 1
sTables = sTables & sTableName & vbNewLine
End If
Next tbl

MsgBox sTables

oConn.Close
Set oCat = Nothing

End Sub

lifeson
05-01-2007, 06:16 AM
Once again XLD thanks :thumb
That works fine to create a long message box but runs out of space (the database I am working on contains over 250 tables.)
So what I was after was the list to be created in a column on a spreadsheet.
I was then going to use the list as the rowsource for a list box starting with code below
Sub GetData()

Dim sDbName As String
Dim Cnct As String, Src As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Integer
Dim sTable As String
Cells.Clear

sTable = FrmSelector.lstTblName.Value

' Database information
sDbName = ThisWorkbook.Path & "\PremierPlusCatalogue.mdb"

' Open the connection
Set Connection = New ADODB.Connection
Cnct = "Provider=Microsoft.Jet.OLEDB.4.0; "
Cnct = Cnct & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Cnct

' Create RecordSet
Set Recordset = New ADODB.Recordset
With Recordset
' Filter
Src = "SELECT * FROM TblComponentDetail" 'I need this bit (tblComponentDetail) to be a variable from the listbox value. sTable doesnt seem to work
.Open Source:=Src, ActiveConnection:=Connection
' Write the field names
For Col = 0 To Recordset.Fields.Count - 1
Range("A1").Offset(0, Col).Value = Recordset.Fields(Col).Name
Next
' Write the recordset
Range("A1").Offset(1, 0).CopyFromRecordset Recordset
End With
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing
End Sub

Bob Phillips
05-01-2007, 06:22 AM
Sub GetTables()
Dim oConn As Object
Const sFilename As String = "C:\program files\Microsoft Office 97\Office\Samples\NORTHWIND.mdb"
Dim oCat As Object 'ADOX.Catalog
Dim tbl As Object 'ADOX.Table
Dim iRow As Long
Dim sConnString As String
Dim sTableName As String
Dim cLength As Integer
Dim iTestPos As Integer
Dim iStartpos As Integer
Dim sTables As String

sConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
sFilename

Set oConn = CreateObject("ADODB.Connection")
oConn.Open sConnString
Set oCat = CreateObject("ADOX.Catalog")
Set oCat.ActiveConnection = oConn

iRow = 1
For Each tbl In oCat.Tables
If (tbl.Type <> "ACCESS TABLE" And _
tbl.Type <> "SYSTEM TABLE") Then
sTableName = tbl.Name
cLength = Len(sTableName)
iTestPos = 0
iStartpos = 1
iRow = iRow + 1
Cells(iRow, "A").Value = sTableName
End If
Next tbl

oConn.Close
Set oCat = Nothing

End Sub