VBAを使用してAccessからExcelに追加する

Question

この特定の問題では、ExcelからエクスポートされたデータをExcelに追加するコードを取得できません。私は、フォームに表示されたいくつかのデータを持つ簡単なAccessデータベースを作成しました。その後、コードを使用して、表示されたレコードをExcelにエクスポートすることができます。

これまでのところとても良いです。しかし、次のレコードをエクスポートすると、Excelの1行目にエクスポートされた以前のデータが上書きされます。コードを次の行に追加するなどします。

"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

私はこれを試しましたが、問題はありません。あなたが正しいエクセルライブラリへの参照を持っていると仮定すると、これが動作するかどうかを確認できますか？

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