Dim conn As New ADODB.Connection
Dim reco As New ADODB.Recordset
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\aaa.mdb;Persist Security Info=False"
conn.Open
Set reco = conn.OpenSchema(20)
Do WHILE NOT reco.eof()
MsgBox reco.Fields("TaBLE_NAME").Value
reco.MoveNext
Loop
Dim reco As New ADODB.Recordset
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\aaa.mdb;Persist Security Info=False"
conn.Open
Set reco = conn.OpenSchema(20)
Do WHILE NOT reco.eof()
MsgBox reco.Fields("TaBLE_NAME").Value
reco.MoveNext
Loop
cmbTableList.Clear
Dim intTablesAdded As Integer
On Error GoTo ListTablesError
Screen.MousePointer = vbHourglass
If cn.State = 0 Then cn.Open ConnectStr
If RS.State = 1 Then RS.Close
Set RS = cn.OpenSchema(adSchemaTables)
Do While Not RS.EOF
Select Case RS(2).Value
'Case "dynasegment" , "mediavoice", "mediavideo", "mediatext", "mediasubobj", "mediaimagedynasegment", "mediaimage"
Case "MSysRelationships", "MSysQueries", "MSysObjects", "MSysModules2", "MSysModules", "MSysACEs", "MSysAccessObjects"
Case Else
cmbTableList.AddItem RS(2).Value
intTablesAdded = intTablesAdded + 1
End Select
RS.MoveNext
Loop
Screen.MousePointer = vbDefault
ListTables = intTablesAdded
Set cn = Nothing
Set RS = Nothing
Exit Function
ListTablesError:
Screen.MousePointer = vbDefault
Select Case Err.Number
Case 3706
MsgBox "当前系统不提供此数据库格式驱动支持! ", vbOKOnly + vbInformation, App.Title
Case Else
End Select
Set cn = Nothing
Set RS = Nothing
ListTables = 0
End Function
Dim DB As Database
Dim TableName As StringSet DB = OpenDatabase(数据库名)For h = 1 To DB.TableDefs.Count - 1
TableName = DB.TableDefs(h).Name
'系统表名不显示
If InStr(1, TableName, "MS") > 0 Then
GoTo nexttable
End If
msgbox tablenamenexttable:
Next h