Импорт в определенный лист Excel из Access через VBA

Question

Я пытаюсь выяснить, как получить данные, которые я импортирую в Excel, из таблицы Access для импорта на конкретный лист (либо лист, называемый просто «Лист 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 * 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

Если вы хотите скопировать ваши данные на конкретный лист, например с именем 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 2

Здесь приведен общий код для импорта данных из определенных таблиц во все файлы 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

Answer 3

Опечатка, 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