使用 VBA 从 Access 追加到 Excel

Question

由于这个特殊问题，我无法获取将导出数据从 Access 附加到 Excel 的代码。我创建了一个简单的 Access 数据库，其中一些数据显示在表单上。之后，可以使用代码将显示的记录导出到 Excel。

到目前为止一切顺利。但是，当我导出下一条记录时，它会覆盖 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