通过 vba 将 MDB Table 导入 EXCEL - 需要字段 names/headers

Question

我在网上找到了这段代码，可以将访问记录导入 excel。 strFilePath 是 MDB 的文件路径，strTableName 是我要导入的 table 名称

Sub importAccessdata()

Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sQRY As String
Dim strFilePath As String

strFilePath = Sheets("Setup").Range("C2").Value
strTableName = Sheets("Setup").Range("C4").Value

Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset

cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strFilePath & ";"

sQRY = "SELECT * FROM " & strTableName & ""

rs.CursorLocation = adUseClient
rs.Open sQRY, cnn, adOpenStatic, adLockReadOnly

Application.ScreenUpdating = False
Sheet3.Range("A1").CopyFromRecordset rs

rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
Exit Sub

End Sub

所有记录的导入速度都非常快，但是我无法使用它们填充字段名称！我可以做一个简单的修改来携带数据中的字段名称吗？

Answer 1

这是我用的-

Private Sub PullSummaryData()
Const strDb As String = "C:\db\AccessDatabase.accdb"
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim i As Integer

Sheets("Summary").Select

  Const strQry As String = "SELECT * FROM [AccessDataTable]"

  Set cn = New ADODB.Connection
  cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDb & ";"

  Set rs = New ADODB.Recordset

  With rs
    Set .ActiveConnection = cn
    .Open strQry
  End With

With Sheets("Summary")
  For i = 1 To rs.Fields.Count
    .Cells(2,i).Value = rs.Fields(i-1).Name  'fields is a 0 based collection
  Next i
  .Range("A3").CopyFromRecordset rs
End With

  rs.Close
  cn.Close
End Sub

通过 vba 将 MDB Table 导入 EXCEL - 需要字段 names/headers

Import MDB Table into EXCEL via vba - Need field names/headers

import

excel

vba

ms-access-2010