我正在努力将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
修订代码:
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
您在查阅列中看到的实际上是连接的产物,因此要获取名称而不是定义SQL查询所需的ID并导出其结果而不是表本身。要包含主表中的所有记录,您需要使用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