Sub TableInfo()
　Dim i, j As Integer, Fname As String
　Dim db1 As Database, Td1 As TableDefs
　Dim fld1 As Fields
　Dim FieldNum, RecNum As Integer

　Fname$ = "d:\mdb\xx.mdb" ‘XX为ACCESS数据库文件
　Set db1 = OpenDataBase(Fname$) '打开一数据库文件
　Set Td1 = db1.TableDefs
　For i = 1 To Td1.Count - 1
　　Debug.Print Td1(i).Name ‘输出表名
　　Set fld1 = Td1(i).Fields '出错！！！！
　　FieldNum = fld1.Count
　　RecNum = Td1(i).RecordCount
　　Debug.Print "当前表共有"; FieldNum; "个字段" ‘输出字段的个数
　　Debug.Print "当前表有:"; RecNum; "记录" ‘输出记录的个数
　　For j = 0 To fld1.Count - 1
　　　Debug.Print "字段名", fld1(j).Name ‘输出字段名
　　　Debug.Print "类型", fld1(j).Type ‘输出字段类型
　　Next j
　Next i
End Sub

请高手指教一下

[CODE]Option Explicit
Private Sub Form_Click()
'添加ado引用
Dim Con As New ADODB.Connection
Dim Rs As ADODB.Recordset
Dim frs As ADODB.Recordset
Con.CursorLocation = adUseClient
Con.Open "Provider=SQLOLEDB;Data Source=(local);Initial Catalog=Northwind;User ID=sa;Password=admin;"
Set Rs = Con.OpenSchema(adSchemaTables)
Dim i As Integer
Dim tbname As String

While Not Rs.EOF
If Rs.Fields("Table_Type") = "TABLE" Then
tbname = Rs.Fields("Table_name").Value
Debug.Print tbname
Set frs = New ADODB.Recordset
frs.CursorLocation = adUseClient
frs.Open "select * from [" & tbname & "] where 1=2", Con, adOpenForwardOnly, adLockReadOnly, adCmdText
For i = 0 To frs.Fields.Count - 1
Debug.Print " " & frs.Fields(i).Name
Next
frs.Close
Set frs = Nothing
End If
Rs.MoveNext
Wend
Rs.Close
Con.Close
End Sub[/CODE]

同意楼上的!

我写过一个导出acc到excel的函数啊

'*************************************************************************
'**函 数 名：ExportTableToOneExcel
'**输 入：ByVal AccName(String) -数据库的名称
'** ：ByVal ExpExcelName(String) -导出excel的名称
'** ：Optional tableName(String = "") -要导出的表明 默认为空代表导出所有表
'** ：Optional DbPassWord(String = "") -数据库的密码 默认为空
'**输 出：无
'**功能描述：实现把acc数据库的表导出到excel里面
'**全局变量：在执行此函数前 先要 引用ado和access
'**调用模块：
'**作 者：心中有剑
'**日 期：2007-08-28 13:27:40
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Public Function ExportTableToOneExcel(ByVal AccName As String, ByVal ExpExcelName As String, Optional tableName As String = "", Optional DbPassWord As String = "")
Dim i As Long
Dim rstSchema As ADODB.Recordset
Dim accApp As Access.Application
Dim cnnTemp As ADODB.Connection
Set accApp = New Access.Application
accApp.OpenCurrentDatabase AccName, , DbPassWord '打开数据库
Set cnnTemp = accApp.CurrentProject.Connection '设置ado的连接为当前数据库的连接
Set rstSchema = cnnTemp.OpenSchema(adSchemaTables)
Do Until rstSchema.EOF
If rstSchema("TABLE_TYPE") = "TABLE" Then
For i = 0 To rstSchema.Fields.Count - 1
If rstSchema(i).Name = "TABLE_NAME" Then '判断是不是用户表
If tableName <> "" Then '判断是否要导出制定表
If rstSchema.Fields(i).Value = tableName Then
accApp.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, tableName, ExpExcelName, True
Exit Do
End If
Else '导出所有表
accApp.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, rstSchema.Fields(i).Value, ExpExcelName, True
End If
End If
Next
End If
rstSchema.MoveNext
Loop
rstSchema.Close
Set cnnTemp = Nothing
accApp.CloseCurrentDatabase
Set accApp = Nothing
End Function