Use ADO to add or update date in Access

[ptrively]

All:

I have what I think is a simple problem, but I can't seem to figure it
out.

I have an employee evaluation form in Excel. I want to take the data from
that form, and dump it into access. The kick is, if someone has already
put this employee into Access, I just want it to overwrite it with the new
information.

I'm not worried about data integrity at the moment, I just need it to work


Here's the code now, all of this works if no primary keys are duplicated.
The primary key name RACFID is located in cell A1, and date located in
cells A2:AX. If I run this once, it updates like a champ, if I run it
twice with the same data it kills it.

Basically I need some code that says "If RACFID exists, then update, else,
addnee"

Any help would be extremely appreciated!

Sub ADOFromExcelToAccess()
'
' ADOFromExcelToAccess Macro
' Macro recorded 8/11/2005 by Project Management Office
'
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use

Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=P:\Shared\PDR\employeeDB.mdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open tableName, cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
r = 2 ' the start row in the worksheet

If ActiveSheet.Name = "Developer" Then
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("RACFID") = Range("A" & r).Value
.Fields("Employee_Type") = "Developer_Table"
.Fields(Range("C1").Value) = Range("C" & r).Value
.Fields(Range("D1").Value) = Range("D" & r).Value
.Fields(Range("E1").Value) = Range("E" & r).Value
.Fields(Range("F1").Value) = Range("F" & r).Value
.Fields(Range("G1").Value) = Range("G" & r).Value
.Fields(Range("H1").Value) = Range("H" & r).Value
.Fields(Range("I1").Value) = Range("I" & r).Value
.Fields(Range("J1").Value) = Range("J" & r).Value
.Fields(Range("K1").Value) = Range("K" & r).Value
.Fields(Range("L1").Value) = Range("L" & r).Value
.Fields(Range("M1").Value) = Range("M" & r).Value
.Fields(Range("N1").Value) = Range("N" & r).Value
.Fields(Range("O1").Value) = Range("O" & r).Value
.Fields(Range("P1").Value) = Range("P" & r).Value
.Fields(Range("Q1").Value) = Range("Q" & r).Value
.Fields(Range("R1").Value) = Range("R" & r).Value
.Fields(Range("S1").Value) = Range("S" & r).Value
.Fields(Range("T1").Value) = Range("T" & r).Value
.Fields(Range("Y1").Value) = Range("U" & r).Value
.Fields(Range("V1").Value) = Range("V" & r).Value
.Fields(Range("W1").Value) = Range("W" & r).Value
.Fields(Range("X1").Value) = Range("X" & r).Value
.Fields(Range("Y1").Value) = Range("Y" & r).Value
.Fields(Range("Z1").Value) = Range("Z" & 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
cn.Close
Set cn = Nothing

End Sub

 

[K Dales]

Basically you are right - it is a pretty simple problem. I will outline
below what you need to do:
1) Use your code as is to retrieve your recordset. Since you already
retrieve the entire table you have everything you need.
2) Within your Do loop, after reading the row, use the rs.Find method to try
to see if the RACFID you have in Excel already is there in the recordset. If
not, continue with your .AddNew method to append the row as a new record
3) If you find that the RACFID does already exist, your rs.Find should have
put you onto the matching record. Now set those Field values equal to the
updated values from Excel and then (important) remember to do an rs.Update to
actually update that record in the database.

You seem to have a good enough handle on it to manage this with my brief
explanation, but if you need help coding it post again - and also check out
the MSDN ADO reference for details on how rs.Find and rs.Update work (a
search for ADO Find or ADO Update will get you to specific info):
http://msdn.microsoft.com/data/

 

[K Dales]

One more thing: you should be able to "reuse" the whole section where you set
the field values since whether you do an "append" or an "update" you will be
setting the field values to the same Excel values. The only difference will
be whether you are on a new record (having done the .AddNew) or whether you
are on the record to update (from your .Find). So save yourself the coding,
right!

 

[ptrively]

Thanks for the quick reply. I've been reading through the MSN database to
try and figure out the best way to do the search. I believe where I'm
having the problem is I can't determine what the find function returns,
this is what I believe the code should look like...But it is not working,
all of the fields on the MSN website list as optional, so I'm at a bit of
a loss.

If ActiveSheet.Name = "Sr Developer" Then
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A

If rs.Find(Range("A" & r).Value) = False Then
With rs

.AddNew ' create a new record
' add values to each field in the record
.Fields("RACFID") = Range("A" & r).Value
.Fields("Employee_Type") = "Senior_Developer"
.Fields(Range("C1").Value) = Range("C" & r).Value
.Fields(Range("D1").Value) = Range("D" & r).Value
.Fields(Range("E1").Value) = Range("E" & r).Value
.Update
' add more fields if necessary...
End With
r = r + 1 ' next row
Loop
Else
With rs
.Update ' create a new record
' add values to each field in the record
.Fields("RACFID") = Range("A" & r).Value
.Fields("Employee_Type") = "Senior_Developer"
.Fields(Range("C1").Value) = Range("C" & r).Value
.Fields(Range("D1").Value) = Range("D" & r).Value
.Fields(Range("E1").Value) = Range("E" & r).Value
.Update
' add more fields if necessary...
End With
r = r + 1 ' next row
Loop
End If

 

[K Dales]

rs.Find is not really a function, but an object method, so it doesn't return
anything in the usual sense. Instead it will move your recordset's cursor
either to the found record (if there is a match) or to the end of file (EOF)
if there is no match. So the way to use it would be:
rs.Find("RACFID=" & Range("A" & r).Value) ' This performs the search
If rs.EOF Then AddNew
' if we are at the end of file then the RACFID was not found so add a new
one
' otherwise: nothing. If it was found you rs is now pointing to the
record you want updated. So there is no ELSE clause, the IF is a one liner!
' so now set (or reset) the values of the fields
.Fields("RACFID") = Range("A" & r).Value
.Fields("Employee_Type") = "Senior_Developer"
.Fields(Range("C1").Value) = Range("C" & r).Value
...
.Update ' will actually execute the changes on the database

So in the end it really is a simple addition to the code (see what I meant
about reusing the .Fields()= section?). The only "tricky" things that might
cause problems:
1) Is the RACFID a numeric field in the database? I wrote the above
assuming it is, if it is text you will need to force single quotes around it,
rs.Find("RACFID='" & Range("A" & r).Value & "'")
2) If the .Find or .Update fail you might need to change the CursorType or
CursorLocation for rs. I don't often use KeySet cursors so I am not so
familiar with how it handles updates - but I think if your current code to
add a record is working on the database, you should also be able to change an
existing record. This is often a confusing and tricky thing, though.

I hope this gets it working for you.
- K Dales

 

[ptrively]

First, thanks for all of your help so far! I think the problem is almost
solved.

The RACFID is a text field (alphanumeric, 5 characters). So I imbedded it
in the single parenthese.

My code now looks like this:

Do While Len(Range("A" & r).Formula) > 0
rs.Find ("RACFID='" & Range("A" & r).Value & "'")
If rs.EOF Then
With rs
.AddNew
.Fields("RACFID") = Range("A" & r).Value
.Fields("Employee_Type") = "Senior_Developer"
.Fields(Range("C1").Value) = Range("C" & r).Value
...
.Fields(Range("AB1").Value) = Range("AB" & r).Value
.Fields(Range("AC1").Value) = Range("AC" & r).Value
.Update

End With

End If
r = r + 1 ' next row
Loop

When running the code one line at a time, If rs.EOF = true, is returning a
true value, but I was still getting the primary key error.

So I changed the cursor location from the default to: rs.CursorLocation =
adUseClient

However; when I do that, the error goes away, but it's only because the
rs.EOF is always false. Changing rs.CursorLocation to server, allows
rs.EOF to be true, but gives the same error.

Using cursorlocation server or client, with each of the four key types
netted the expected results, when key location server was selected, EOF
was true, but the update failed, if location was set to client, the
operation never failed, but it also never attempted to update (and thus
didn't work).

For all of these attempts, if the data contained all new records, the
update worked fine. So it appears I still have the same symptom as my
original code, of not being able to overwrite. I am starting to wonder if
it's something in the database that's preventing it.

Any further thoughts would be appreciated!

 

[ptrively]

Else
If ActiveSheet.Name = "Sr Developer" Then
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
rs.Find ("RACFID='" & Range("A" & r).Value & "'")

If rs.EOF Then rs.AddNew

With rs
.Fields("RACFID") = Range("A" & r).Value
.Fields("Employee_Type") = "Senior_Developer"
.Fields(Range("C1").Value) = Range("C" & r).Value

I reread your instructions and now have placed the add new at the end of
the If statement, which makes much more sense!

Still getting the same error though, but with these new changes, I'm going
to attempt adjusting the cursor settings again.

I'll keep you updated!

 

[ptrively]

Else
If ActiveSheet.Name = "Sr Developer" Then
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
rs.Find ("RACFID='" & Range("A" & r).Value & "'")

If rs.EOF Then rs.AddNew

With rs
.Fields("RACFID") = Range("A" & r).Value
.Fields("Employee_Type") = "Senior_Developer"
.Fields(Range("C1").Value) = Range("C" & r).Value

I reread your instructions and now have placed the add new at the end of
the If statement, which makes much more sense!

Still getting the same error though, but with these new changes, I'm going
to attempt adjusting the cursor settings again.

I'll keep you updated!

 

[ptrively]

Okay, with the addition of the new code, I am getting a new problem,
although it looks like it has a promising solution.

When I execute the code, the first row of data updates! But the second
row fails.

If ActiveSheet.Name = "Sr Developer" Then
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
rs.Find ("RACFID='" & Range("A" & r).Value & "'")

If rs.EOF Then rs.AddNew

With rs

In code break mode, on the first pass through rs.EOF = false, and it
updates the data accordingly.

However, on the second pass through; rs.EOF becomes true, and thus fails,
because the record does actually exist.

Is there another function beside EOF that I can use to detect if a record
was found or not?

Thanks,

~Paul

 

[ptrively]

YAY!

I added a moveFirst function into the solution, and it seems to be working
just fine now, even with multiple records.

Thanks so much for the help!

Final Solution:

If ActiveSheet.Name = "Sr Developer" Then
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A

rs.MoveFirst
rs.Find ("RACFID='" & Range("A" & r).Value & "'")

If rs.EOF Then rs.AddNew

With rs

 

[K Dales]

Great!!! I felt bad because I realized this morning that in my response last
night I had forgotten to mention the need to MoveFirst before the Find (blame
it on a late night session!). I realized this morning and have been trying
to respond before now but work duties and computer problems kept me from
doing it. Glad you found it on your own (and maybe it even helped you learn
a bit!) and I think you have it now. I apologize for the oversight and any
extra work it caused you but glad it seems to have worked for you!