VBA - a command button for both overwrite and append

[Pergega]

Hi

I have a command button on my spreadsheet, the function is to overwrite and append data from excel to 2 different tables in access.

I run the code there seems to be no error, but I check the database there is no new record or overwrites been added. Do you think you can help me to identify the error please?


Private Sub UpdateButton_Click()

'Table name from database

strTable = "TextID"

Call ConnectToDatabase
Set rs = New ADODB.Recordset
rs.Open strTable, cn, adOpenKeyset, adLockOptimistic, adCmdTable
' open a recordset
r = 7
Do While Len(Range("A" & r).Formula) > 1
' the start row in the worksheet
With rs
' add values to each field in the record
.Fields("col852") = Range("G" & r).Value
.Fields("col44") = Range("H" & r).Value
.Update ' stores the new record
r = r + 1 ' next row
End With
rs.MoveNext
Loop
rs.Close
Set rs = Nothing

strTable2 = "FoodCategory"
Set rs2 = New ADODB.Recordset
rs2.Open strTable2, cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
r = 7
Do While Not Range("A" & r).Value = ""
' the start row in the worksheet
With rs2
' add values to each field in the record
.Fields("DisplayOrder") = Range("G" & r).Value
.Fields("BackColor") = Range("H" & r).Value
r = r + 1 ' next row
End With
rs2.MoveNext
Loop
rs2.Close
Set rs2 = Nothing
cn.Close
Set cn = Nothing
End Sub