【原】Excel VBA 读取Access数据库字段信息

最近在做一个小项目《财务管理系统》，用来财务记账的。主要是以Excel作为操作端，Access作为数据存储端。

在对access数据库进行操作过程中，想把数据库最新的字段信息保存下来，在新建账套的时候，可以参考，甚至于根据这些信息，直接创建同样的数据表。经过一番烧脑的操作，与ChatGPT作了深入交谈，得到一大堆代码，最终完成了这个Sub GetTableColumnsInfo()，感觉不错，分享一下思路，代码附后（注：这些代码只是作为思路分享，直接复制并不能正常运行。）

Sub GetTableColumnsInfo()    Dim cn As Object     Dim rs As Object     Dim col As Integer    Dim arrTables()     '存放表名    Dim arrFields()    Dim arr(), arrT()    Dim fldName As String    Set cn = CreateObject("ADODB.Connection")    Set rs = CreateObject("ADODB.Recordset")    Psw = clsGT.GetPsW    arrTables = clsDQ.GetAllTables    StrCnn = clsGT.GetStrCnn(DataFile, Psw)    cn.Open StrCnn    ReDim arr(0 To 4, 0 To 0)    arr(0, 0) = "TableName"    arr(1, 0) = "FidldName"    arr(2, 0) = "DataType"    arr(3, 0) = "Size"    arr(4, 0) = "Default"     For i = LBound(arrTables) To UBound(arrTables)        tableName = arrTables(i)        sql = "select top 1 *  from " & tableName        arrFields = clsDQ.GetFields(sql)        j = UBound(arrFields) - 1        k = UBound(arr, 2) + 1        ReDim Preserve arr(0 To 4, 0 To j + k)        For t = k To UBound(arr, 2)            arr(0, t) = tableName            arr(1, t) = arrFields(t - k)        Next     Set rs = cn.OpenSchema(4, Array(Empty, Empty, tableName))        Do Until rs.EOF           fldName = rs("COLUMN_NAME")           For m = k To UBound(arr, 2)              If arr(1, m) = fldName Then                 arr(2, m) = rs("DATA_TYPE")                 arr(3, m) = rs("CHARACTER_MAXIMUM_LENGTH")                 arr(4, m) = rs("COLUMN_DEFAULT")              End If           Next            rs.MoveNext           Loop     Next    iRow = UBound(arr, 2)    iCol = UBound(arr, 1)    ReDim arrT(0 To iRow, 0 To iCol)    For i = 0 To iRow        For j = 0 To iCol            arrT(i, j) = arr(j, i)        Next    Next    Sheets("数据库表信息").Cells.ClearContents    Sheets("数据库表信息").Range("A1").Resize(iRow + 1, iCol + 1) = arrT    rs.Close    cn.Close    Set rs = Nothing    Set cn = NothingEnd Sub

首先，定义一些变量。

psw是数据库密码，存在excel文件中，这里用一个自定义的函数来获取密码。

arrTables是一个数组，存放所有表的名称，后面也是一个自定义函数。

strCnn是数据库连接，后面也是自定义函数，参数是数据库文件完整路径和密码；其结果大概是这个样子：

StrCnn = "Provider=Microsoft.ACE.OLEDB.12.0;Jet OLEDB:Database Password=" & Psw & ";Data Source=" & DbFile

arr是一个数组，用于存放所有获取的表信息，先加上标题，然后根据某一个表的字段数量，redim preserve数组。

然后打开记录集Set rs = cn.OpenSchema(4, Array(Empty, Empty, tableName))，取得字段的名称、类型、长度、默认值信息，存到数组里。

完成后，把数组转置一下，存入excel表中。结果是这样子的：

这样，就导出了所有表的信息，可以在新建一个数据库的时候，根据这些表的字段信息，批量创建表啦。

至于如何创建新的表及字段，我们下期再讲。