MS Excel VBA - 导入访问 (MDB) 表结构答案

【问题标题】：MS Excel VBA - Import an access (MDB) tables structureMS Excel VBA - 导入访问 (MDB) 表结构
【发布时间】：2020-07-05 21:59:54
【问题描述】：

我有这个sn-p，可以将访问表导入excel。 MDB 路径在 C2 范围内，表名是 C4

有没有办法可以导入表格的属性/设计并使用 excel vba 将其写入新位置？这将用于许多具有不同技能水平且具有不同表结构的人要导入。数据最终将不得不重新访问，但我对如何确保访问中的字段属性正确感到困惑。

Sub GetData()

DeleteConnections 'remove existing connections in case they persist
Sheet4.Cells.Clear 'clear the old table

Sheets("Import").Activate

DatabaseName = Sheets("Setup").Range("C2").Value
TableName = Sheets("Setup").Range("C4").Value

    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=" & DatabaseName & "" _
        , _
        ";Mode=Share" _
        , _
        " Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OL" _
        , _
        "EDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet" _
        , _
        " OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Loc" _
        , _
        "ale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet" _
        , " OLEDB:Bypass UserInfo Validation=False"), Destination:=Range("$A$1")). _
        QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array("" & TableName & "")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = _
        "" & DatabaseName & ""
        .ListObject.DisplayName = "" & TableName & ""
        .Refresh BackgroundQuery:=False
    End With

DeleteConnections 'remove the new connection

End Sub

【问题讨论】：

您可以为特定数据库使用TableDefs 对象。 This 会给你一些有用的开始。
另一种选择是使用 ADO 检查数据库架构。 an example here 会是一个好的开始。

标签： excel vba ms-access

【解决方案1】：

如果你想要的只是表的结构，你可以劫持ADODB.RecordSet类来暴露字段名、数据类型和长度。像这样的东西应该工作。在本例中，他们只会在活动电子表格的 A、B 和 C 列中列出它们：

Sub GetDataFieldInfo()

  Dim conn As ADODB.Connection
  Dim rs As ADODB.Recordset

  Set conn = New ADODB.Connection
  conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0" & _
      ";Data Source=" & DatabaseName & _
      ";Persist Security Info=False;"
  conn.Open

  Set rs = conn.Execute("select * from " & TableName)
  For i = 0 To rs.Fields.Count - 1
    Cells(i + 1, 1).Value2 = rs(i).Name
    Cells(i + 1, 2).Value2 = TypeName(rs.Fields(i).Value)
    Cells(i + 1, 3).Value2 = rs.Fields(i).DefinedSize
  Next
  rs.Close

End Sub

我在一个示例表上运行它，结果如下所示：

ID              Long             4
Date Entered    Date             8
Business Unit   String         255
Type Code       String         255

您可能想看看它如何处理空数据。

【讨论】：

正是我想要做的。非常感谢

【解决方案2】：

这是一个 sn-p，它将遍历 QueryTable 的源表的列名：

Dim qt As QueryTable
Dim lo As ListObject
Dim lc As ListColumn

Set qt = ActiveSheet.ListObjects(1).QueryTable

Set lo = qt.ListObject

For Each lc In lo.ListColumns
    Debug.Print lc.Name
Next

Set lc = Nothing
Set lo = Nothing
Set qt = Nothing

这是用于演示目的的冗长，显然可以重构。

【讨论】：