Добавить в Excel из Access с помощью VBA

Question

С этой конкретной проблемой я не могу получить код для добавления экспортированных данных из Access в Excel. Я создал простую базу данных Access с некоторыми данными, показанными в форме. После этого можно экспортировать указанную запись в Excel с помощью кода.

Пока все хорошо. Но когда я экспортирую следующую запись, она перезаписывает предыдущие экспортированные данные в строке 1 в Excel. Я хочу, чтобы код добавлялся к следующей строке и так далее.

Я нашел несколько тем о том, как добавить «ActiveCell.Value» и «ActiveCell.Offset», но мои знания слишком ограничены, чтобы заставить его работать с кодом. Как только я думаю, что у меня это получилось, VBE приходит с ошибками. Кажется, я не могу понять это.

Private Sub Command15_Click() 
Dim oExcel   As Object 
Dim oExcelWrkBk  As Object 
Dim oExcelWrSht  As Object 
Dim bExcelOpened As Boolean 

'Start Excel 
On Error Resume Next 
Set oExcel = GetObject(, "Excel.Application") 'Bind to existing instance of Excel 
If Err.Number <> 0 Then 'Could not get instance of Excel, so create a new one 
    Err.Clear 
    On Error GoTo Error_Handler 
    Set oExcel = CreateObject("excel.application") 
    bExcelOpened = False 
Else 'Excel was already running 
    bExcelOpened = True 
End If 
On Error GoTo Error_Handler 
oExcel.ScreenUpdating = False 
oExcel.Visible = False 'Keep Excel hidden until we are done with our manipulation 
'Set oExcelWrkBk = oExcel.Workbooks.Add() 'Start a new workbook 
Set oExcelWrkBk = oExcel.Workbooks.Open("C:\test.xlsx")  'Open an existing Excel file 
Set oExcelWrSht = oExcelWrkBk.Sheets(1) 'which worksheet to work with 

'Start copying over your form values to the Excel Spreadsheet 
'Cells(8, 3) = 8th row, 3rd column 
oExcelWrSht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = Me.1 
oExcelWrSht.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0) = Me.2 
oExcelWrSht.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = Me.3 
oExcelWrSht.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = Me.4 
oExcelWrSht.Cells(Rows.Count, 5).End(xlUp).Offset(1, 0) = Me.5 
oExcelWrSht.Cells(Rows.Count, 6).End(xlUp).Offset(1, 0) = Me.6 
oExcelWrSht.Cells(Rows.Count, 7).End(xlUp).Offset(1, 0) = Me.7 
oExcelWrSht.Cells(Rows.Count, 8).End(xlUp).Offset(1, 0) = Me.8 
oExcelWrSht.Cells(Rows.Count, 9).End(xlUp).Offset(1, 0) = Me.9 
'... and so on ... 

oExcelWrSht.Range("A1").Select 'Return to the top of the page 

' oExcelWrkBk.Close True, sFileName 'Save and close the generated workbook 
' 'Close excel if is wasn't originally running 
' If bExcelOpened = False Then 
'  oExcel.Quit 
' End If Error_Handler_Exit: 
On Error Resume Next 
oExcel.Visible = True 'Make excel visible to the user 
Set oExcelWrSht = Nothing 
Set oExcelWrkBk = Nothing 
oExcel.ScreenUpdating = True 
Set oExcel = Nothing 
Exit Sub Error_Handler: 
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _ 
     "Error Number: " & Err.Number & vbCrLf & _ 
     "Error Source: Export2XLS" & vbCrLf & _ 
     "Error Description: " & Err.Description _ 
     , vbOKOnly + vbCritical, "An Error has Occured!" 
Resume Error_Handler_Exit End Sub 

Answer 1

Я пробовал это и никаких проблем, поэтому предполагая, что у вас есть ссылка на правую библиотеку excel, вы можете увидеть, работает ли это?

Sub Test() 
Dim oExcel As Excel.Application 
Dim oExcelWrkBk As Excel.Workbook 
Dim oExcelWrSht As Excel.Worksheet 

'Start Excel 
On Error Resume Next 
Set oExcel = GetObject(, "Excel.Application") 
If Err <> 0 Then 
    Err.Clear 
    On Error GoTo Error_Handler 
    Set oExcel = CreateObject("Excel.Application") 
Else 
    On Error GoTo Error_Handler 
End If 

oExcel.ScreenUpdating = False 
oExcel.Visible = False 'This is false by default anyway 

Set oExcelWrkBk = oExcel.Workbooks.Open("C:\test.xlsx") 
Set oExcelWrSht = oExcelWrkBk.Sheets(1) 

oExcelWrSht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = "Test1" 
oExcelWrSht.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0) = "Test2" 
oExcelWrSht.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = "Test3" 

oExcelWrSht.Range("A1").Select 

oExcelWrkBk.Save 

oExcel.ScreenUpdating = True 
oExcel.Visible = True 

Exit_Point: 
Set oExcelWrSht = Nothing 
Set oExcelWrkBk = Nothing 
Set oExcel = Nothing 
Exit Sub 

Error_Handler: 
MsgBox Err & " - " & Err.Description 
GoTo Exit_Point 
End Sub