I am wondering if anyone can help me with my code. This code will allow certain ranges to be exported to a Access database. I need help writing something that will take the primary_key and search for it in Access to see if it exists. If the primary_key exists, then update the fields. If the primary key does not exist, then the data should be appended to a new row. If you can help, i greatly appreciate it. I am using Microsoft Access and Excel 2010.
Private Sub Append1(startcl As range)
Dim cn As ADODB.Connection
Dim rs As New ADODB.Recordset
Dim r As Long, _
rngColHeads As range, _
rngTblRcds As range, _
colHead As String, _
rcdDetail As String, _
ch As Integer, _
cl As Integer, _
notNull As Boolean, _
dbpath As String, _
tblname As String
'set the string to the path of your database
dbpath = Sheets("Export").range("C7").Value
tblname = Sheets("export").range("c8").Value
Set rngColHeads = Sheets("export").range("tblheadings1")
Set rngTblRcds = Sheets("export").range("tblrecords1")
'Connect to the database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ace.oledb.12.0; " & _
"Data Source ='" & dbpath & "';"
'Concatenate a string with the names of the column headings
colHead = " ("
For ch = 1 To rngColHeads.Count
colHead = colHead & rngColHeads.Columns(ch).Value
Select Case ch
Case Is = rngColHeads.Count
colHead = colHead & ")"
Case Else
colHead = colHead & ","
End Select
Next ch
'Insert records into database from worksheet table
For cl = 1 To rngTblRcds.Rows.Count
'Assume record is completely Null, and open record string for concatenation
notNull = False
rcdDetail = "('"
'Evaluate field in the record
For ch = 1 To rngColHeads.Count
Select Case rngTblRcds.Rows(cl).Columns(ch).Value
'if empty, append value of null to string
Case Is = Empty
Select Case ch
Case Is = rngColHeads.Count
rcdDetail = Left(rcdDetail, Len(rcdDetail) - 1) & "NULL)"
Case Else
rcdDetail = Left(rcdDetail, Len(rcdDetail) - 1) & "NULL,'"
End Select
'if not empty, set notNull to true, and append value to string
Case Else
notNull = True
Select Case ch
Case Is = rngColHeads.Count
rcdDetail = rcdDetail & rngTblRcds.Rows(cl).Columns(ch).Value & "')"
Case Else
rcdDetail = rcdDetail & rngTblRcds.Rows(cl).Columns(ch).Value & "','"
End Select
End Select
Next ch
'If record consists of only Null values, do not insert it to table, otherwise
'insert the record
Select Case notNull
Case Is = True
rs.Open "INSERT INTO " & tblname & colHead & " VALUES " & rcdDetail, cn
Case Is = False
'do not insert record
End Select
Next cl
EndUpdate:
'Check if error was encounted
If Err.Number <> 0 Then
'Error encountered. Rollback transaction and inform user
On Error Resume Next
cn.RollbackTrans
MsgBox "There was an error. Update was not succesful!", vbCritical, "Error!"
Else
On Error Resume Next
cn.CommitTrans
End If
'Close the ADO objects
cn.Close
Set rs = Nothing
Set cn = Nothing
On Error GoTo 0
End Sub
Bookmarks