将数据从MS Access表单复制到Excel中

Question

我的代码从MS Access表单中获取字段并将数据复制到已保存的Excel文件中。导入到Excel中的Access中的第一条记录的范围为A2：I2。 Access中的第二条记录导入到Excel中，范围为A3：I3，等等....现在发生的事情是，如果我在Access中关闭表单并将其打开并说已导入两条记录到这个相同的Excel文件中，现在我想添加第三条记录，它将在第一行（A2：I2）处重新开始，并且写下已经存在的内容。我的问题是，如果我关闭并打开Access让它不能重新开始（A2：I2），而是从下一个可用的行开始，那么遵循给出的示例将是（A4：I4）？这是我的代码有

Private Sub Command73_Click() 
Set objXLApp = CreateObject("Excel.Application") 
Set objXLBook = objXLApp.Workbooks.Open("Y:\123files\Edmond\Hotel Reservation Daily.xls") 
objXLApp.Application.Visible = True 

With objXLBook.ActiveSheet 

Set r = .usedRange 
i = r.Rows.Count + 1 

.Cells(i + 1, 1).Value = Me.GuestFirstName & " " & GuestLastName 
.Cells(i + 1, 2).Value = Me.PhoneNumber 
.Cells(i + 1, 3).Value = Me.cboCheckInDate 
.Cells(i + 1, 4).Value = Me.cboCheckOutDate 
.Cells(i + 1, 5).Value = Me.GuestNo 
.Cells(i + 1, 6).Value = Me.RoomType 
.Cells(i + 1, 7).Value = Me.RoomNumber 
.Cells(i + 1, 8).Value = Date 
.Cells(i + 1, 9).Value = Me.Employee 
End With 

Set r = Nothing 
Set objXLBook = Nothing 
Set objXLApp = Nothing 

End Sub 

Answer 1

你可以得到最后使用的一行：

Set r = objXLBook.ActiveSheet.UsedRange 
i = r.Rows.Count + 1 

的一些注意事项。

Private Sub Command73_Click() 
''It is always a good idea to put sensible names on command buttons. 
''It may not seem like much of a problem today, but it will get there 
Dim objXLApp As Object 
Dim objXLBook As Object 
Dim r As Object 
Dim i As Integer 

''It is nearly always best to check whether Excel is open before 
''opening another copy. 
Set objXLApp = CreateObject("Excel.Application") 
Set objXLBook = objXLApp.Workbooks.Open(_ 
     "Y:\123files\Edmond\Hotel Reservation Daily.xls") 
objXLApp.Application.Visible = True 

''It is generally best to specify the sheet 
''With objXLBook.ActiveSheet 

With objXLBook.Sheets("Room Reservation") 

    ''If the used range includes empty rows 
    ''it may not suit 
    ''Set r = .UsedRange 
    ''i = r.Rows.Count + 1 

    ''From comments, it appears that the data is dense 
    ''but with a number of empty rows at the end of the sheet 

    i = .Range("A1").End(xlDown).Row + 1 

    .Cells(i, 1).Value = Me.GuestFirstName & " " & GuestLastName 
    .Cells(i, 2).Value = Me.PhoneNumber 
    .Cells(i, 3).Value = Me.cboCheckInDate 
    .Cells(i, 4).Value = Me.cboCheckOutDate 
    .Cells(i, 5).Value = Me.GuestNo 
    .Cells(i, 6).Value = Me.RoomType 
    .Cells(i, 7).Value = Me.RoomNumber 
    .Cells(i, 8).Value = Date 
    .Cells(i, 9).Value = Me.Employee 

End With 

''Tidy up 
Set objXLBook = Nothing 
Set objXLApp = Nothing 

End Sub 

您可能还想看看TransferSpreadsheet。

另一种可能性是使用RecordsetClone来处理表单或任何记录集中的数据。它没有给出完全相同的控制，但它非常快：

Dim objXLApp As Object 
Dim objXLBook As Object 
Dim r As Object 
Dim i As Integer 
Dim rs As DAO.Recordset 

Set objXLApp = CreateObject("Excel.Application") 
objXLApp.Visible = True 
Set objXLBook = objXLApp.Workbooks.Open(_ 
     "Y:\123files\Edmond\Hotel Reservation Daily.xls") 

Set rs = Me.RecordsetClone 
With objXLBook.Sheets("Sheet1") 

    Set r = .UsedRange 
    i = r.Rows.Count + 1 

    .Cells(i, 1).CopyFromRecordset rs 

End With