Use ADO to add or update date in Access
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
|