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

时间:2016-11-28 19:49:31

标签: excel vba excel-vba access

我有一个将访问表导入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

2 个答案:

答案 0 :(得分: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

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

答案 1 :(得分:0)

这是一个代码片段,它将遍历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

这对于演示目的来说很冗长,显然可以重构。