VB Macro Problem

[Bob1866]

Hi, I have got some code in a macro which sends a selection of data to an MS
Access database from Excel, the code works except for the problem that the
row of data is added again and again - last time it copied the same row into
the access table over 95,000 times before i closed excel down to stop it.
Here is the code:


Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
Set db = OpenDatabase("\\Hs-dhgl1d6\share\James Computer Backup\Network
Drive\Network Services for Sorting\DATABASES\01017508.mdb")
' open the database
Set rs = db.OpenRecordset("Expense Details", dbOpenTable)
' get all records in a table
r = 42 ' the start row in the worksheet
Do While Len(Range("R2" & v2).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' create a new record
' add values to each field in the record
.Fields("ExpenseReportID") = Range("R2").Value
.Fields("ExpenseCategoryID") = Range("U2").Value
.Fields("ExpenseItemAmount") = Range("V2").Value
.Fields("ExpenseItemDescription") = Range("T2").Value
.Fields("ExpenseDate") = Range("S2").Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub

I think the problem might be the "loop" part but I do not know enough about
VB coding to sort this out, I am just wondering if somebody could edit the
above code so that the same row is not added the the table over and over
again.

Many Thanks.

Windows XP Professional
Office 2003

 

[Joel]

You were in an endless loop always looking a row 2. I mdofied the code to
look at row "R"

Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
Set db = OpenDatabase("\\Hs-dhgl1d6\share\James Computer Backup\Network
Drive\Network Services for Sorting\DATABASES\01017508.mdb")
' open the database
Set rs = db.OpenRecordset("Expense Details", dbOpenTable)
' get all records in a table
r = 42 ' the start row in the worksheet
Do While Range("R" & r) <> ""
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' create a new record
' add values to each field in the record
.Fields("ExpenseReportID") = Range("R" & r).Value
.Fields("ExpenseCategoryID") = Range("U" & r).Value
.Fields("ExpenseItemAmount") = Range("V" & r).Value
.Fields("ExpenseItemDescription") = Range("T" & r).Value
.Fields("ExpenseDate") = Range("S" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub