PDA

View Full Version : Send to DB code change



Marcster
09-05-2009, 03:15 AM
Hi People,

I have the below code in a Sub which scans down a list on a sheet
and copies the filled rows to an Access database.

What I need to do is now amend the code so that if cell AI is blank of the row then copy the row (A:AH) to the database, if the cell is has a "Yes" do not copy it.
Once a row has been copied to the database put a "Yes" in col AI on that
row. Ans MsgBox to say how many, if any, records have been copied to the
database.


Set rs = db.OpenRecordset("AccessTableName", dbOpenTable)

r = 6 'the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew
.Fields("Field1") = Trim(Range("A" & r).Value)
.Fields("Field2") = Trim(Range("B" & r).Value)
.Fields("Field3") = Trim(Range("C" & r).Value)
.Fields("Field4") = Trim(Range("D" & r).Value)
'ETC....
.Update
End With
r = r + 1
Loop
rs.Close
Set rs = Nothing


Thanks,

p45cal
09-05-2009, 12:52 PM
Set rs = Db.OpenRecordset("AccessTableName", dbOpenTable)
r = 6 'the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
If Range("AI" & r) <> "Yes" Then
With rs
.AddNew
.Fields("Field1") = Trim(Range("A" & r).Value)
.Fields("Field2") = Trim(Range("B" & r).Value)
.Fields("Field3") = Trim(Range("C" & r).Value)
.Fields("Field4") = Trim(Range("D" & r).Value)
'ETC....
.Update
End With
Range("AI" & r) = "Yes"
End If
r = r + 1
Loop
rs.Close
Set rs = Nothing
Note that this tests not for AI being blank, but for it not being "Yes"
(And my red highlighting screws up VBA tags courtesy of thecodenet.com)