Question

我的代码从MS Access表单中获取字段并将数据复制到已保存的Excel文件中。 Access中的第一条记录导入到Excel，范围为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

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

1 个答案: