將數據從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