retrieving single records from table and updating them

[nils7]

Hi all,

I have a central database that is being updated with values from an excel spreadsheet. I am using the ADO connection method to write each non-empty cell from an Excel sheet into the database. The writing into the database works perfectly fine as long as it is a new record.

What i would like to do now is to write a scipt that can update an existing record in the database table. My idea was to:
(1) read unique identifier for a row in excel
(2) retrieve the record that relates to this identifier in Access (using select * table, connection WHERE AcessID = unique identifier)
(3) change all other fields in the record using the information in the excel row
(4) loop to the next row in excel and repeat

The VBA code sits in a module within the Excel spreadshete and is initiated from Excel.

I am stuck at point (2). The recodset that I select is empty.

I woul be very grateful for any help.

Cheers,

Nils


Option Explicit

Sub update_existing_record()
'updates data from the active worksheet in a table in an Access database

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim r As Long
Dim t1, t2 As String
Dim VClookup, ssql As String

'timestamp 1
t1 = Now()

'this is the excel sheet that has the data
Worksheets("Export").Activate

'connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
"Data Source=\\servera\databasepath\FCSTTestV1.accdb;"


' all records in a table
r = 2 ' the start row in the worksheet

'loop that cycles through list starting in row 2 until end of list

Do While Len(Range("A" & r).Formula) > 0

'assigning value to be looked up to lookup variable
VClookup = Range("A" & r).Value


'lookup
ssql = "select * From fdfolio where [VC] ='VClookup'"

Debug.Print ssql

Set rs = New ADODB.Recordset
rs.Open ssql, cn, adOpenDynamic, adLockOptimistic, adCmdTable


With rs



If Not .BOF And Not .EOF Then
.MoveLast
.MoveFirst

If .Supports(adUpdate) Then
.Fields("AC") = Range("B" & r).Value
.Fields("E") = Range("C" & r).Value
.Fields("CC") = Range("D" & r).Value
.Fields("Ac1") = Range("E" & r).Value
.Fields("Ac2") = Range("F" & r).Value
.Fields("Ac3") = Range("G" & r).Value
.Fields("Ac4") = Range("H" & r).Value
.Fields("P1") = Range("I" & r).Value
.Fields("P2") = Range("J" & r).Value
.Fields("P3") = Range("K" & r).Value
.Fields("P4") = Range("L" & r).Value
.Fields("P5") = Range("M" & r).Value
.Fields("P6") = Range("N" & r).Value
.Fields("P7") = Range("O" & r).Value
.Fields("P8") = Range("P" & r).Value
.Fields("P9") = Range("Q" & r).Value
.Fields("P10") = Range("R" & r).Value
.Fields("P11") = Range("S" & r).Value
.Fields("P12") = Range("T" & r).Value
.Fields("FCST") = Range("U" & r).Value
.Fields("B") = Range("V" & r).Value
.Fields("Updated") = Now()

.Update
.Save


End If

End If

.Close

End With

r = r + 1

Loop

'emptying recordset and closing connection

Set rs = Nothing
cn.Close
Set cn = Nothing
'timestamp 2
t2 = Now()
'output time taken to process records
MsgBox t1 & " to " & t2

End Sub



Some more information about my data setup:

My excel data is in a sheet called "Export". Each column relates to one ofthe fields in the access database table called "fdfolio".
The unique identifier is in row A in the Excel sheet and this is the field called "VC" in the database. It is the first field in the table fdfolio

[jonh]

The recordset being empty would either suggest there are no matching records or an error has occurred.

Anyway, you should avoid using a recordset wherever possible. You've no need to return a recordset because you can simply execute a command.

e.g.


Private Const ACC2007 As String = "provider=microsoft.ace.oledb.12.0;data source=%db%;"
Private Const db As String = "C:\example.accdb"


Sub example()
With New ADODB.Connection
.Open Replace(ACC2007, "%db%", db)
somesql = "insert into table1 (txt1, txt2) values ('hello', 'world')"
.Execute somesql
.Close
End With
End Sub

The above would insert a new record. If you want to edit a record use an update query instead.

[nils7]

Hi Jonh

Thanks a lot for taking the time to answer and for the code example.

Upon implementing this, I have come across a couple of (probably really obvious) points that I am stuck with:

(1) In the line

somesql = "insert into table1 (txt1, txt2) values ('hello', 'world')"
how do I go about using variables or cell references (eg. Range ("B" & r).Value ) instead of text ('hello', 'world')?

(2) if I have a table called fdfolio that has columns VC,E,AC,CC,AC1,AC2 etc. is the correct statement:

somesql = "INSERT into fdfolio (VC,E,AC,CC,AC1,AC2.....) values.....?

(3) If I want to update a record, what would I use for the update query that you mention?

cheers,

Nils

[jonh]

1) You just build a string.


SQLValues = " values ("
SQLValues = SQLValues & "'" & range("b" & r).Value & "'"
SQLValues = SQLValues & "'" & range("c" & r).Value & "'"
'...etc
SQLValues = SQLValues & ")"

SQL = "insert into yourtable (field,list,here)" & SQLValues


2) correct

3) build the sql string similar to above, but you need to supply the id of the record(s) you want to update


"update yourtable set ac='" & range("a" & r).Value & "',e='" & range("a" & r).Value & "' where id=" & r

[nils7]

Hi Jonh

Thank you so much for your help. It has taken me a while, but with your coding tips i have finally managed to get my procedure to update my records.

I am pasting my final code should anyone else have a similar question.

Cheers,

Nils

P.s: I am using a slightly clunky method to test whether a record exists already and needs to be updated or whether a new record needs to be created. I am sure there are much better ways to achieve this. For the moment this will have to do for me though.


Option Explicit
Private Const ACC2010 As String = "provider=microsoft.ace.oledb.12.0;data source=%db%;"
Private Const db As String = "C:\Users\me\Documents\TEST.accdb"
Sub send_to_myDB()

Dim somesql, excelvalues, sqlvalues As String
Dim r As Integer
Dim cn As ADODB.Connection
Dim t1, t2 As Date

'timestamp to test duration of transfer
t1 = Now()


'making the worksheet active that houses the data in excel to be transfered
Worksheets("Export").Activate
'row to start transferring
r = 2

'making the connection
Set cn = New ADODB.Connection


cn.Open Replace(ACC2010, "%db%", db)

'loop through rows

Do While Len(Range("A" & r).Formula) > 0

sqlvalues = " values ("
sqlvalues = sqlvalues & "'" & Range("A" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("B" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("C" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("D" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("E" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("F" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("G" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("H" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("I" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("J" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("K" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("L" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("M" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("N" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("O" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("P" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("Q" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("R" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("S" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("T" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("U" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Range("V" & r).Value & "',"
sqlvalues = sqlvalues & "'" & Now() & "')"

'if the execute statement returns an error (because the records exist already, skip to the updating code
On Error Resume Next
'add as new
somesql = "insert into mytable (VC, AC, E, CC, AC1, AC2, AC3, AC4, P1, P2, P3, P4, P5, P6, P7, P8, P9, P10, P11, P12, FCST, B, UPDATED)" & sqlvalues

cn.Execute somesql


'alternative;y replace current record
sqlvalues = " set AC='" & Range("B" & r).Value & "',"
sqlvalues = sqlvalues & "E='" & Range("C" & r).Value & "',"
sqlvalues = sqlvalues & "CC='" & Range("D" & r).Value & "',"
sqlvalues = sqlvalues & "AC1='" & Range("E" & r).Value & "', "
sqlvalues = sqlvalues & "AC2='" & Range("F" & r).Value & "', "
sqlvalues = sqlvalues & "AC3='" & Range("G" & r).Value & "', "
sqlvalues = sqlvalues & "AC4='" & Range("H" & r).Value & "', "
sqlvalues = sqlvalues & "P1='" & Range("I" & r).Value & "', "
sqlvalues = sqlvalues & "P2='" & Range("J" & r).Value & "', "
sqlvalues = sqlvalues & "P3='" & Range("K" & r).Value & "', "
sqlvalues = sqlvalues & "P4='" & Range("L" & r).Value & "', "
sqlvalues = sqlvalues & "P5='" & Range("M" & r).Value & "', "
sqlvalues = sqlvalues & "P6='" & Range("N" & r).Value & "', "
sqlvalues = sqlvalues & "P7='" & Range("O" & r).Value & "', "
sqlvalues = sqlvalues & "P8='" & Range("P" & r).Value & "', "
sqlvalues = sqlvalues & "P9='" & Range("Q" & r).Value & "', "
sqlvalues = sqlvalues & "P10='" & Range("R" & r).Value & "', "
sqlvalues = sqlvalues & "P11='" & Range("S" & r).Value & "', "
sqlvalues = sqlvalues & "P12='" & Range("T" & r).Value & "', "
sqlvalues = sqlvalues & "FCST='" & Range("U" & r).Value & "', "
sqlvalues = sqlvalues & "B='" & Range("V" & r).Value & "', "
sqlvalues = sqlvalues & "UPDATED='" & Now() & "' "
sqlvalues = sqlvalues & "where VC='" & Range("A" & r).Value & "'"

somesql = "update mytable" & sqlvalues



On Error GoTo 0

cn.Execute somesql

'for the loop go to the next row
r = r + 1
Loop
'close the connection
cn.Close
'second timestamp
t2 = Now

MsgBox "from " & t1 & " to " & t2

End Sub