如何遍历MS Access DB中的所有表

时间:2013-07-09 18:05:30

标签: ms-access access-vba

我需要读取Access 2003数据库中超过100个表的属性,并将这些详细信息(表名,字段名,类型和大小)写入文件以供进一步说明。

我无法从网页搜索中找到有关阅读字段属性,只搜索字段值...

的内容

有人可以告诉我,我必须声明哪些记录集变量(以及语法)来遍历数据库中的所有表,并从每个表中提取字段名称,类型和大小?我将结果写入文本文件,但我想我可以处理! :)

我处于停滞状态,直到我能解决这个问题。我花了一天时间手动记录两张表。有些表格有100多个字段。

3 个答案:

答案 0 :(得分:19)

带有这些选项的Database Documenter向导应该能够以最少的努力为您提供所需的功能。

enter image description here

如果该方法不能令人满意,您可以使用自定义VBA代码来收集所需的信息。您可以通过循环遍历DAO TableDefs集合来检索数据库中表的名称。

Dim db As DAO.Database
Dim tdf As DAO.TableDef
Set db = CurrentDb
For Each tdf In db.TableDefs
    ' ignore system and temporary tables
    If Not (tdf.name Like "MSys*" Or tdf.name Like "~*") Then
        Debug.Print tdf.name
    End If
Next
Set tdf = Nothing
Set db = Nothing

要获取所需的字段详细信息,请调整Allen Browne的TableInfo() function ...替换文件写入Debug.Print语句的语句。请注意,该函数使用2个辅助函数GetDescripFieldTypeName,这两个函数都包含在该链接页面中。

以下是来自TableInfo()的立即窗口输出样本,用于我的数据库中的表格 - 我认为它包含了您想要的字段信息。

TableInfo "foo"
FIELD NAME    FIELD TYPE    SIZE          DESCRIPTION
==========    ==========    ====          ===========
id            AutoNumber     4            
MyNumber      Long Integer   4            
MyText        Text           255          
bar           Long Integer   4            
==========    ==========    ====          ===========

在您调整了该函数后,请从上面示例中的For Each tdf循环中调用它,并为每个tdf.name提供它:

TableInfo tdf.name

答案 1 :(得分:5)

你将不得不稍微调整一下,它旨在将表从一个数据库复制到另一个数据库,但它应该是一个很好的起点。

    ' Database.
    Dim dbRep As DAO.Database
    Dim dbNew As DAO.Database

    ' For copying tables and indexes.
    Dim tblRep As DAO.TableDef
    Dim tblNew As DAO.TableDef
    Dim fldRep As DAO.Field
    Dim fldNew As DAO.Field
    Dim idxRep As DAO.Index
    Dim idxNew As DAO.Index

    ' For copying data.
    Dim rstRep As DAO.Recordset
    Dim rstNew As DAO.Recordset
    Dim rec1 As DAO.Recordset
    Dim rec2 As Recordset
    Dim intC As Integer

    ' For copying table relationships.
    Dim relRep As DAO.Relation
    Dim relNew As DAO.Relation

    ' For copying queries.
    Dim qryRep As DAO.QueryDef
    Dim qryNew As DAO.QueryDef

    ' For copying startup options.
    Dim avarSUOpt
    Dim strSUOpt As String
    Dim varValue
    Dim varType
    Dim prpRep As DAO.Property
    Dim prpNew As DAO.Property

    ' For importing forms, reports, modules, and macros.
    Dim appNew As New Access.Application
    Dim doc As DAO.Document

    ' Open the database, not in exclusive mode.
    Set dbRep = OpenDatabase(Forms!CMDB_frmUpgrade.TxtDatabase, False)


    ' Open the new database
    Set dbNew = CurrentDb

    DoEvents

    ' Turn on the hourglass.
    DoCmd.Hourglass True

    '********************
    Debug.Print "Copy Tables"
    '********************
If Forms!CMDB_frmUpgrade.CkTables = True Then
    Forms!CMDB_frmUpgrade.LstMessages.addItem "Copying Tables:"

    ' Loop through the collection of table definitions.
    For Each tblRep In dbRep.TableDefs
    Set rec1 = dbRep.OpenRecordset("SELECT MSysObjects.Name FROM MsysObjects WHERE ([Name] = '" & tblRep.Name & "') AND ((MSysObjects.Type)=4 or (MSysObjects.Type)=6)")

    If rec1.EOF Then
      XF = 0
    Else
      XF = 1
    End If

        ' Ignore system tables and CMDB tables.
        If InStr(1, tblRep.Name, "MSys", vbTextCompare) = 0 And _
            InStr(1, tblRep.Name, "CMDB", vbTextCompare) = 0 And _
            XF = 0 Then

            '***** Table definition
            ' Create a table definition with the same name.
            Set tblNew = dbNew.CreateTableDef(tblRep.Name)
            Forms!CMDB_frmUpgrade.LstMessages.addItem "--> " & tblRep.Name & ""

            ' Set properties.
            tblNew.ValidationRule = tblRep.ValidationRule
            tblNew.ValidationText = tblRep.ValidationText

            ' Loop through the collection of fields in the table.
            For Each fldRep In tblRep.Fields

                ' Ignore replication-related fields:
                ' Gen_XXX, s_ColLineage, s_Generation, s_GUID, s_Lineage
                If InStr(1, fldRep.Name, "s_", vbTextCompare) = 0 And _
                    InStr(1, fldRep.Name, "Gen_", vbTextCompare) = 0 Then

                    '***** Field definition
                    Set fldNew = tblNew.CreateField(fldRep.Name, fldRep.Type, _
                        fldRep.Size)

                    ' Set properties.
                    On Error Resume Next
                    fldNew.Attributes = fldRep.Attributes
                    fldNew.AllowZeroLength = fldRep.AllowZeroLength
                    fldNew.DefaultValue = fldRep.DefaultValue
                    fldNew.Required = fldRep.Required
                    fldNew.Size = fldRep.Size

                    ' Append the field.
                    tblNew.Fields.Append fldNew
                    'On Error GoTo Err_NewShell
                End If
            Next fldRep

            '***** Index definition

            ' Loop through the collection of indexes.
            For Each idxRep In tblRep.Indexes

                ' Ignore replication-related indexes:
                ' s_Generation, s_GUID
                If InStr(1, idxRep.Name, "s_", vbTextCompare) = 0 Then

                    ' Ignore indices set as part of Relation Objects
                    If Not idxRep.Foreign Then

                        ' Create an index with the same name.
                        Set idxNew = tblNew.CreateIndex(idxRep.Name)

                        ' Set properties.
                        idxNew.Clustered = idxRep.Clustered
                        idxNew.IgnoreNulls = idxRep.IgnoreNulls
                        idxNew.Primary = idxRep.Primary
                        idxNew.Required = idxRep.Required
                        idxNew.Unique = idxRep.Unique

                        ' Loop through the collection of index fields.
                        For Each fldRep In idxRep.Fields
                            ' Create an index field with the same name.
                            Set fldNew = idxNew.CreateField(fldRep.Name)
                            ' Set properties.
                            fldNew.Attributes = fldRep.Attributes
                            ' Append the index field.
                            idxNew.Fields.Append fldNew
                        Next fldRep

                        ' Append the index to the table.
                        tblNew.Indexes.Append idxNew
                    End If
                End If
            Next idxRep

            ' Append the table.
            dbNew.TableDefs.Append tblNew
        End If
    Next tblRep

答案 2 :(得分:0)

以下子项会将所有表名,字段名,类型,required和默认值导出到Excel工作表中

Sub TableDef()
 Dim def As TableDef
 Dim wb As Object
 Dim xL As Object
 Dim lngRow As Long
 Dim f As Field
 Set xL = CreateObject("Excel.Application")
 xL.Visible = True
 Set wb = xL.workbooks.Add
 lngRow = 2
 For Each def In CurrentDb.TableDefs
   For Each f In def.Fields
     With wb.sheets("Sheet1")
           .Range("A" & lngRow).Value = def.Name
           .Range("B" & lngRow).Value = f.Name
           .Range("C" & lngRow).Value = f.Type
           .Range("D" & lngRow).Value = f.Size
           .Range("E" & lngRow).Value = f.Required
           .Range("F" & lngRow).Value = f.DefaultValue
            lngRow = lngRow + 1
    End With
   Next
 Next
End Sub