使用VBA从Access附加到Excel [英] Append to Excel from Access using VBA

问题描述

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

With this particular problem I can’t get the code to append the exported data from Access to Excel. I have created an simple Access database with some data shown on a form. After that it is possible to export the shown record to Excel using the code.

到目前为止，一切都很好.但是，当我导出下一条记录时，它会覆盖Excel中第一行上的先前导出的数据.我希望代码附加到下一行，依此类推.

So far so good. But when I export the next record it overwrites the previous exported data on row one in Excel. I want the code to append to the next row and so on.

我发现了一些有关如何附加"ActiveCell.Value"和"ActiveCell.Offset"的主题，但是我的知识太有限，无法与代码一起使用.我想知道的那一刻，VBE出现了错误.看来我想不通.

I have found some topics on how to append with "ActiveCell.Value" and "ActiveCell.Offset" but my knowledge is too limited to get it to work with the code. The moment I think I got it, VBE comes with errors. It seems I can't figure this out.

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

推荐答案

我已经尝试过了，没有任何问题，因此，假设您对正确的excel库有引用，就可以看到它是否可行?

I've tried this and no problems so assuming you have a reference to the right excel library can you see if this works?

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

这篇关于使用VBA从Access附加到Excel的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！