我有一个将访问表导入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
答案 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
这对于演示目的来说很冗长,显然可以重构。