vb如何取得Access数据库中的table列表？

Question

1、如何在创建一个到Access数据库的Ado连接后，取得该数据库中的所有表名到一个列表控件，以便选择连接到相应表？
2、如何在创建一个到Access数据库中某表的Ado连接后，取得该表的字段列表？
谢谢！

Answer 1

Public constr As String '数据库连接字符串'**过程名：loadMDB
'**功能描述：查询列举.mdb数据库中的对象.
'**输    入：constr   ADO的数据库连接字符串.
'**        ：INType  要列出的类型:1为查询,2为窗体,3为表,4为报表,5为模块,6为宏.
'**        ：INlist  写入的目的控件,类型是ListBox.
'**输    出：添加并现实到相应的ListBox控件.
'**全局变量：
'**调用模块：Microsoft ADO Ext. 2.x for DDL and Security
'**       : Microsoft ActiveX Data Object 2.x（版本号）
'**作    者：passer
'**日    期：2003年12月5日
'*************************************************************************
Public Sub loadMDB(constr As String, INtype As Integer, INlist As ListBox)
On Error GoTo loadMDB_ErrorHandler
Screen.MousePointer = 11    Dim con As New ADODB.Connection      'ADO连接
    Dim rs As New ADODB.Recordset        'ADO记录集
    Dim sql As String                    '查询sql
        If rs.State <> adStateClosed Then
        rs.Close
        Set rs = Nothing
    End If
    
    con.Open (constr)
    Select Case INtype
        Case 1  '查询
            sql = "SELECT MSysObjects.Name FROM MsysObjects WHERE (Left([Name],1)<>'~') AND (MSysObjects.Type)=5 ORDER BY MSysObjects.Name"
            rs.CursorLocation = adUseClient
            rs.Open sql, con, adOpenDynamic, adLockPessimistic
            If Not (rs.EOF = True And rs.BOF = True) Then
                INlist.Clear
                Do Until rs.EOF = True
                    INlist.AddItem rs.Fields("Name").Value
                    rs.MoveNext
                Loop
            Else
                INlist.Clear
                Exit Sub
            End If
            
            Case 2  '窗体
            sql = "SELECT MSysObjects.Name FROM MsysObjects WHERE (Left([Name],1)<>'~') AND (MSysObjects.Type)=-32768 ORDER BY MSysObjects.Name"
            rs.CursorLocation = adUseClient
            rs.Open sql, con, adOpenDynamic, adLockPessimistic
            If Not (rs.EOF = True And rs.BOF = True) Then
                INlist.Clear
                Do Until rs.EOF = True
                    INlist.AddItem rs.Fields("Name").Value
                    rs.MoveNext
                Loop
            Else
                INlist.Clear
                Exit Sub
            End If
            
            Case 3  '表
            sql = "SELECT MSysObjects.Name FROM MsysObjects WHERE (Left([Name],1)<>'~') AND (Left$([Name],4) <> 'Msys') AND (MSysObjects.Type)=1 ORDER BY MSysObjects.Name"
            rs.CursorLocation = adUseClient
            rs.Open sql, con, adOpenDynamic, adLockPessimistic
            If Not (rs.EOF = True And rs.BOF = True) Then
                INlist.Clear
                Do Until rs.EOF = True
                    INlist.AddItem rs.Fields("Name").Value
                    rs.MoveNext
                Loop
            Else
                INlist.Clear
                Exit Sub
            End If
            
            Case 4  '报表
            sql = "SELECT MSysObjects.Name FROM MsysObjects WHERE (Left([Name],1)<>'~') AND (MSysObjects.Type)= -32764 ORDER BY MSysObjects.Name"
            rs.CursorLocation = adUseClient
            rs.Open sql, con, adOpenDynamic, adLockPessimistic
            If Not (rs.EOF = True And rs.BOF = True) Then
                INlist.Clear
                Do Until rs.EOF = True
                    INlist.AddItem rs.Fields("Name").Value
                    rs.MoveNext
                Loop
            Else
                INlist.Clear
                Exit Sub
            End If
            
            Case 5  '模块
            sql = "SELECT MSysObjects.Name FROM MsysObjects WHERE (Left([Name],1)<>'~') AND (MSysObjects.Type)= -32761 ORDER BY MSysObjects.Name"
            rs.CursorLocation = adUseClient
            rs.Open sql, con, adOpenDynamic, adLockPessimistic
            If Not (rs.EOF = True And rs.BOF = True) Then
                INlist.Clear
                Do Until rs.EOF = True
                    INlist.AddItem rs.Fields("Name").Value
                    rs.MoveNext
                Loop
            Else
                INlist.Clear
                Exit Sub
            End If
            
            Case 6  '宏
            sql = "SELECT MSysObjects.Name FROM MsysObjects WHERE (Left([Name],1)<>'~') AND (MSysObjects.Type)= -32766 ORDER BY MSysObjects.Name"
            rs.CursorLocation = adUseClient
            rs.Open sql, con, adOpenDynamic, adLockPessimistic
            If Not (rs.EOF = True And rs.BOF = True) Then
                INlist.Clear
                Do Until rs.EOF = True
                    INlist.AddItem rs.Fields("Name").Value
                    rs.MoveNext
                Loop
            Else
                INlist.Clear
                Exit Sub
            End If
            
            Case Else
            Exit Sub
    End Select
    
    rs.Close
    Set rs = Nothing
    con.Close
    Set con = Nothing
    Screen.MousePointer = 0
ErrorHandler:
    Exit Sub
loadMDB_ErrorHandler:
    Screen.MousePointer = 0
    MsgBox Err.Description
    Resume ErrorHandler
End Sub

Answer 2

看
http://www.csdn.net/Develop/read_article.asp?id=15422

Answer 3

'**函数名：GetFieldType  '(该函数只列出了access库常用的数据类型,所以字段数据类型不完全).
'**功能描述：匹配相应的字段类型名称.
'**输    入：intType 字段类型对应的整型数.
'**输    出：GetFieldType 返回对应的字段名称.
'**全局变量：
'**调用模块：
'**作    者：passer
'**日    期：2003年12月8日
'*************************************************************************
Public Function GetFieldType(intType As Integer) As String
'该函数只列出了access库常用的数据类型,所以字段数据类型不完全
On Error GoTo GetFieldType_ErrorHandler
Screen.MousePointer = 11    Select Case intType
        Case adLongVarChar
            GetFieldType = "adLongVarChar"      '长字符串值（仅用于 Parameter 对象）
        Case adInteger
            GetFieldType = "adInteger"          '4 字节的带符号整型 (DBTYPE_I4)
        Case adSingle
            GetFieldType = "adSingle"           '单精度浮点值 (DBTYPE_R4)
        Case adChar
            GetFieldType = "adChar"             '字符串值
        Case adVarWChar
            GetFieldType = "adVarWChar"         '以空结尾的 Unicode 字符串（仅 Parameter 对象）。
        Case adDBDate
            GetFieldType = "adDBDate"           '日期值 (yyyymmdd) (DBTYPE_DBDATE)
        Case adDate
            GetFieldType = "adDate"             '日期值 (DBTYPE_DATE)。日期按双精度型数值来保存，数字全部表示从 1899 年 12 月 30 开始的日期数。小数部分是一天当中的片段时间
        Case adSmallInt
            GetFieldType = "adSmallInt"         '2 字节带符号整型 (DBTYPE_I2)
        Case adUnsignedTinyInt
            GetFieldType = "adUnsignedTinyInt"  '1 字节不带符号整型 (DBTYPE_UI1)
        Case adCurrency
            GetFieldType = "adUnsignedTinyInt"  '货币值 (DBTYPE_CY)。货币数字的小数点位置固定、小数点右侧有四位数字。该值保存为 8 字节范围为 10,000 的带符号整型值。
        Case adDBTimeStamp
            GetFieldType = "adDBTimeStamp"      '时间戳（yyyymmddhhmmss 加 10 亿分之一的小数）(DBTYPE_DBTIMESTAMP)
        Case Else
            MsgBox "未知的数据类型！", vbInformation, "提示！"
            Exit Function
   End Select
   
ErrorHandler:
    Exit Function
GetFieldType_ErrorHandler:
    Screen.MousePointer = 0
    MsgBox Err.Description
    Resume ErrorHandler
End Function'**过程名：GetFields
'**功能描述：查询列举.mdb数据库中各个表的字段信息 (主要是:字段名称,数据类型,字段大小).
'**输    入：constr   ADO的数据库连接字符串.
'**输    出：输出显示到立即窗口中 (如没看到输出结果'视图'菜单--〉立即窗口)
'**全局变量：
'**调用模块：
'**作    者：passer
'**日    期：2003年12月8日
'*************************************************************************
Public Sub GetFields(constr As String)
On Error GoTo GetFields_ErrorHandler
Screen.MousePointer = 11    Dim con As New ADODB.Connection       'ADO连接对象
    Dim sql_query As String               '查询表对象的sql
   
    Dim rs As New ADODB.Recordset         'ADO记录集
    Dim fld As ADODB.Field                'ADO字段
    Dim strSQL As String                  '查询表字段的sql
    Dim i As Integer, j As Integer
    
    Dim Arr_TableName() As String              '表名称数组'查询表对象
    con.Open (constr)
    sql_query = "SELECT MSysObjects.Name FROM MsysObjects WHERE (Left([Name],1)<>'~') AND (Left$([Name],4) <> 'Msys') AND (MSysObjects.Type)=1 ORDER BY MSysObjects.Name"
    rs.CursorLocation = adUseClient
    rs.Open sql_query, con, adOpenDynamic, adLockPessimistic
    If Not (rs.EOF = True And rs.BOF = True) Then
        ReDim Arr_TableName(1 To rs.RecordCount)  '确定数组Arr_TableName的最大下标
        For i = 1 To rs.RecordCount
            Arr_TableName(i) = rs.Fields("Name").Value
            rs.MoveNext
        Next i
    Else
        Exit Sub
    End If
    rs.Close
    For j = 1 To UBound(Arr_TableName)
        strSQL = "SELECT TOP 1 * FROM " & Arr_TableName(j) & ""
        rs.CursorLocation = adUseClient
        rs.Open strSQL, constr, adOpenDynamic, adLockPessimistic    For Each fld In rs.Fields
        Debug.Print "  FieldName: " & fld.Name
        Debug.Print "  FieldType: " & GetFieldType(fld.Type)
        Debug.Print "  FieldDefinedSize: " & fld.DefinedSize & vbLf
    Next
        rs.Close
        Set rs = Nothing
    Next j
    
    Screen.MousePointer = 0
ErrorHandler:
    Exit Sub
GetFields_ErrorHandler:
    Screen.MousePointer = 0
    MsgBox Err.Description
    Resume ErrorHandler
End Sub

Answer 4

注意:1.工程--->引用--->Microsoft ADO Ext. 2.x for DDL and Security
  工程--->引用--->Microsoft ActiveX Data Object 2.x（版本号）    2.如出现查询出错或选择的文件不是test3.mdb时,请对.mdb文件做以下操作操作
用Access打开数据库,工具-〉安全-〉用户与组的权限-〉选中表MsysObjects的读取数据权限;
这样就可以通过查询系统表MsysObjects来查询所有对象了。3.点击菜单 '在立即窗口中输出各表的字段信息' ,如没看到输出结果应对VB IDE作以下设置: '视图'菜单--〉立即窗口

Answer 5

注明:以上主要是得到了小马哥   yoki(小马哥)  的指导完成的!如有错误,望大家指正!