dbConnectADO

Dim varTables, varFields As Variant
Dim strDataBasePath As String
Function GetTableNames(ByVal strDatabaseName As String) As Variant
Dim rsTables As ADODB.Recordset
Dim adoTables As ADODB.Connection
Dim fldTables As Variant
Set adoTables = New ADODB.Connection
adoTables.CursorLocation = adUseClient
adoTables.Mode = adModeShareExclusive
adoTables.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Chr$(34) & strDatabaseName & Chr$(34) & ";Persist Security Info=False"
Set rsTables = adoTables.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "TABLE"))
If rsTables.RecordCount = 0 Then
MsgBox ("Keine Tabellen in dieser Datenbank!")
intTableCounter = 0
Exit Function
End If
ReDim fldTables(rsTables.RecordCount - 1)
rsTables.MoveFirst
For intCounter = 0 To (rsTables.RecordCount) - 1
fldTables(intCounter) = rsTables!Table_Name
rsTables.MoveNext
If rsTables.EOF Then
Exit For
End If
Next
intTableCounter = (rsTables.RecordCount)
rsTables.Close
adoTables.Close
GetTableNames = fldTables
End Function

Function GetFieldNames(ByVal strTable As String, ByVal strDatabaseName As String) As Variant
Dim rsFields As ADODB.Recordset
Dim adoFields As ADODB.Connection
Dim fldTables As Variant
Dim strDummy As String

Set rsFields = New ADODB.Recordset
Set adoFields = New ADODB.Connection
adoFields.CursorLocation = adUseClient
adoFields.Mode = adModeShareExclusive
adoFields.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Chr$(34) & strDatabaseName & Chr$(34) & ";Persist Security Info=False"
strDummy = "[" & strTable & "]"
rsFields.LockType = adLockOptimistic
rsFields.Open strDummy, adoFields, adOpenDynamic, adLockOptimistic, adCmdTable
ReDim fldTables(rsFields.Fields.Count - 1)
For intCounter = 0 To (rsFields.Fields.Count) - 1
fldTables(intCounter) = rsFields.Fields.Item(intCounter).Name
Next
intFieldCounter = (rsFields.Fields.Count - 1)
rsFields.Close
adoFields.Close

GetFieldNames = fldTables

End Function

Private Sub cmdExit_Click()
Unload frmTables
End Sub

Private Sub Form_Load()
dlgDatabase.ShowOpen
strDataBasePath = dlgDatabase.FileName
varTables = GetTableNames(strDataBasePath)
If UBound(varTables) > -1 Then
For intCounter = 0 To UBound(varTables)
lstTables.AddItem (varTables(intCounter))
Next
End If

End Sub

Private Sub lstTables_DblClick()
intItem = lstTables.ListIndex
lstFields.Clear
Set varFields = Nothing
varFields = GetFieldNames(lstTables.List(intItem), strDataBasePath)
If UBound(varFields) > -1 Then
For intCounter = 0 To UBound(varFields)
lstFields.AddItem (varFields(intCounter))
Next
End If
End Sub