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

Private Function ListTables() As Integer
    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

来晚了！
呵呵

Private Sub Command1_Click()
Dim DB As Database
Dim TableName As String

Set 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 tablename

nexttable:
 Next h
 

各位大虾，多谢了！