通过VBA从Access导入到特定的Excel工作表

Question

我试图弄清楚如何从Access表中获取要导入到Excel中的数据以导入到特定的工作表（一个仅称为工作表2的工作表或Access Data）中。 我有以下代码来获取数据并在导入后以所需的方式对其进行格式化，但是我无法将其导入到特定的工作表中。 我可以得到协助吗？ 这是我所拥有的：

更新分辨率的代码：

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 * 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

有一个错字， SELECT*FROM ，应该是SELECT * FROM 。

如果要导入到特定的工作表中，请output名称，请尝试替换：

1. Range("A5").Offset(0, Col).Value = Recordset.Fields(Col).Name带Worksheets("output").Range("A5").Offset(0, Col).Value = Recordset.Fields(Col).Name
2. Range("A5").Offset(1, 0).CopyFromRecordset Recordset带有Worksheets("output").Range("A5").Offset(1, 0).CopyFromRecordset Recordset Range("A5").Offset(1, 0).CopyFromRecordset Recordset Worksheets("output").Range("A5").Offset(1, 0).CopyFromRecordset Recordset

Answer 2

如果要在特定的工作表中复制数据，例如名为Sheet2工作表

' Declare a worksheet object
Dim objSheet As Worksheet

' initialize it
Set objSheet = ActiveWorkbook.Sheets("Sheet2")

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

'Write Recordset
objSheet.Range("A5").Offset(1, 0).CopyFromRecordset Recordset

Answer 3

这是通用代码，用于从单个文件夹中所有EXCEL文件（所有文件中的工作表名称均相同）中的特定工作表中导入数据。 具有相同工作表名称的所有EXCEL文件的工作表必须具有相同的布局和格式的数据。

Sub TryThis()

Dim strPathFile As String, strFile As String, strPath As String
Dim blnHasFieldNames As Boolean
Dim intWorksheets As Integer

' Replace 3 with the number of worksheets to be imported
' from each EXCEL file
Dim strWorksheets(1 To 3) As String

' Replace 3 with the number of worksheets to be imported
' from each EXCEL file (this code assumes that each worksheet
' with the same name is being imported into a separate table
' for that specific worksheet name)
Dim strTables(1 To 3) As String

' Replace generic worksheet names with the real worksheet names;
' add / delete code lines so that there is one code line for
' each worksheet that is to be imported from each workbook file
strWorksheets(1) = "GenericWorksheetName1"
strWorksheets(2) = "GenericWorksheetName2"
strWorksheets(3) = "GenericWorksheetName3"

' Replace generic table names with the real table names;
' add / delete code lines so that there is one code line for
' each worksheet that is to be imported from each workbook file
strTables(1) = "GenericTableName1"
strTables(2) = "GenericTableName2"
strTables(3) = "GenericTableName3"

' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = False

' Replace C:\Documents\ with the real path to the folder that
' contains the EXCEL files
strPath = "C:\Documents\"

' Replace 3 with the number of worksheets to be imported
' from each EXCEL file
For intWorksheets = 1 To 3

      strFile = Dir(strPath & "*.xls")
      Do While Len(strFile) > 0
            strPathFile = strPath & strFile
            DoCmd.TransferSpreadsheet acImport, _
                  acSpreadsheetTypeExcel9, strTables(intWorksheets), _
                  strPathFile, blnHasFieldNames, _
                  strWorksheets(intWorksheets) & "$"
            strFile = Dir()
      Loop

Next intWorksheets

End Sub