通过 VBA 使用查找列从 Access 导入 Excel

Question

我正在将数据从 Access 表导入 Excel。我拥有的导入代码在拉入数据方面起作用，但是当访问表中的列是从另一个表中查找的值时，我对拉入的数据有疑问。例如，我将EmployeeID 存储在一个单独的表中，该表在我正在提取的表中进行查找。提取提取数据，但它只提取分配给员工表上员工的自动编号，而不是员工姓名。员工姓名存储在员工表的第三列中，当提取运行时我需要该值，而不是自动编号。但是，我不知道如何指定通过 VBA 在 SQL 中提取的列。有人可以帮忙吗？到目前为止，这是我所拥有的：

Sub getAccessData()

Dim DBFullName As String
Dim Connect As String, Source As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Integer
Dim lngLastColumn As Long
Dim lngLastRow As Long
Dim OXLSheet As Worksheet

Set OXLSheet = Worksheets("WorksheetName")

Worksheets("WorksheetName").Cells.Clear

'Datebase path info
DBFullName = "C:\Users\myname\Desktop\Database Backups\database.accdb"

'Open the connection for the database
Set Connection = New ADODB.Connection
Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
Connect = Connect & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Connect


'Create RecordSet
Set Recordset = New ADODB.Recordset
With Recordset

    'Data Filter
    Source = "SELECT EmployeeID FROM tblRetirements WHERE AllowEnteredInPayroll]Is Null AND ApplicationCancelled = 'No'"
    .Open Source:=Source, ActiveConnection:=Connection


    'Write field Names
    For Col = 0 To Recordset.Fields.Count - 1
        Worksheets("WorksheetName").Range("A5").Offset(0, Col).Value = Recordset.Fields(Col).Name
    Next

    'Write Recordset
    Worksheets("WorksheetName").Range("A5").Offset(1, 0).CopyFromRecordset Recordset
End With
ActiveSheet.Columns.AutoFit
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing



With OXLSheet
    lngLastColumn = .Cells(5, .Columns.Count).End(xlToLeft).Column
    lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    .ListObjects.Add(xlSrcRange, .Range(.Cells(5, 1), .Cells(lngLastRow, lngLastColumn)), , xlYes).Name = "Table1"

    ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleMedium16"
End With

End Sub

Answer 1

您在查找列中看到的内容实际上是连接的产物，因此要获取名称而不是 ID，您需要定义 SQL 查询并导出其结果而不是表本身。要包含主表中的所有记录，您需要使用LEFT JOIN。如果您使用INNER JOIN，那么您将得到相同的结果，除非您的主表中有记录，其雇员表中的相关记录已被删除：

Sub getAccessData()

    Dim DBFullName As String
    Dim Connect As String, Source As String
    Dim Connection As ADODB.Connection
    Dim Recordset As ADODB.Recordset
    Dim Col As Integer
    Dim lngLastColumn As Long
    Dim lngLastRow As Long
    Dim OXLSheet As Worksheet

    Set OXLSheet = Worksheets("WorksheetName")

    Worksheets("WorksheetName").Cells.Clear

    'Datebase path info
    DBFullName = "C:\Users\myname\Desktop\Database Backups\database.accdb"

    'Open the connection for the database
    Set Connection = New ADODB.Connection
    Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
    Connect = Connect & "Data Source=" & DBFullName & ";"
    Connection.Open ConnectionString:=Connect


    'Create RecordSet
    Set Recordset = New ADODB.Recordset
    With Recordset

        'Data Filter
        Source = "SELECT tblEmployeeID.Name FROM tblRetirements " & _
        "LEFT JOIN tblEmployeeID on tblRetirements.EmployeeID = tblEmployeeID.Name " & _
        "WHERE [AllowEnteredInPayroll] Is Null AND ApplicationCancelled = 'No'"
        .Open Source:=Source, ActiveConnection:=Connection


        'Write field Names
        For Col = 0 To Recordset.Fields.Count - 1
            Worksheets("WorksheetName").Range("A5").Offset(0, Col).Value = Recordset.Fields(Col).Name
        Next

        'Write Recordset
        Worksheets("WorksheetName").Range("A5").Offset(1, 0).CopyFromRecordset Recordset
    End With
    ActiveSheet.Columns.AutoFit
    Set Recordset = Nothing
    Connection.Close
    Set Connection = Nothing



    With OXLSheet
        lngLastColumn = .Cells(5, .Columns.Count).End(xlToLeft).Column
        lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .ListObjects.Add(xlSrcRange, .Range(.Cells(5, 1), .Cells(lngLastRow, lngLastColumn)), , xlYes).Name = "Table1"

        ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleMedium16"
    End With

End Sub

Answer 2

修改代码：

Sub getAccessData()

Dim DBFullName As String
Dim Connect As String, Source As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Integer
Dim lngLastColumn As Long
Dim lngLastRow As Long
Dim OXLSheet As Worksheet

Set OXLSheet = Worksheets("WorksheetName")

Worksheets("WorksheetName").Cells.Clear

'Datebase path info
DBFullName = "C:\Users\myname\Desktop\Database Backups\database.accdb"

'Open the connection for the database
Set Connection = New ADODB.Connection
Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
Connect = Connect & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Connect


'Create RecordSet
Set Recordset = New ADODB.Recordset
With Recordset

    'Data Filter
    Source = "SELECT tblEmployeeID.Name FROM tblRetirements " & _
    "INNER JOIN tblEmployeeID on tblRetirements.EmployeeID = tblEmployeeID.Name " & _
    "WHERE [AllowEnteredInPayroll] Is Null AND ApplicationCancelled = 'No'"
    .Open Source:=Source, ActiveConnection:=Connection


    'Write field Names
    For Col = 0 To Recordset.Fields.Count - 1
        Worksheets("WorksheetName").Range("A5").Offset(0, Col).Value = Recordset.Fields(Col).Name
    Next

    'Write Recordset
    Worksheets("WorksheetName").Range("A5").Offset(1, 0).CopyFromRecordset Recordset
End With
ActiveSheet.Columns.AutoFit
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing



With OXLSheet
    lngLastColumn = .Cells(5, .Columns.Count).End(xlToLeft).Column
    lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    .ListObjects.Add(xlSrcRange, .Range(.Cells(5, 1), .Cells(lngLastRow, lngLastColumn)), , xlYes).Name = "Table1"

    ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleMedium16"
End With

End Sub