This is kind of sloppy but does work. I posted simple code earlier but some concepts are not simple for more complex database issues. I am not an ADO or database expert by any means. If someone knows how to make it cleaner, feel free to make it so and post the code. If inserting records was just needed, the code could have been much more simple. Part of the sloppiness is all the commented code. As I developed this, I left parts commented as they show methods to achieve certain goals and debugging tips which may help others.
The concepts shown in this final 100% working code are:
1. Adds (similar to Inserts) 3 rows from Excel to 3 NEW records in sakila.film. This happens because I added new and unique primary key values (column 1).
a. See attachment in post 42 for the 3 rows of data. Paste the code below into a Module in that workbook and run it.
2. It has an IF that skips adding data due to the foreign key constraint in column original_language_id which avoids an error.
3. Two commented lines that show how to skip adding a record for a duplicate primary key, film_id.
4. An If routine Updates one record's fields rather than adding a new record if the primary key is a duplicate.
Be sure to modify some data in the 3 rows to test this last update duplicates feature.
Well, that's it. My working MySQL example showing the main concepts of adding records and updating records, and skipping records if primary key is duplicated. The skipping part is commented out. Some might want to skip duplicates and some might want to update duplicate primary key records. This final version does the latter.
Sub InsertIntoMySQLFull()
' How to add the ADO object:
' Tools > References > Microsoft ActiveX Data Objects 2.8 Library
Dim oConn As ADODB.Connection
Dim rs As ADODB.RecordSet, rs2 As ADODB.RecordSet
Dim col As Integer
Dim wsName As String, dbName As String, strSQL As String
Dim a As Variant
Dim c As Range, r As Range, row As Range
wsName = "Film"
dbName = "film"
On Error GoTo ErrHandler
Set rs = New ADODB.RecordSet
Set oConn = New ADODB.Connection
oConn.Open "DRIVER={MySQL ODBC 5.2 ANSI Driver};" & _
"SERVER=localhost;" & _
"DATABASE=Sakila;" & _
"USER=root;" & _
"PASSWORD=kenhob;" & _
"Option=3"
' Create RecordSet
Set rs = New ADODB.RecordSet
With rs
' Record locking ' http://www.utteraccess.com/wiki/index.php?title=Beginners_Guide_To_ODBC
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockOptimistic
strSQL = "SELECT * FROM " & dbName
.Open Source:=strSQL, ActiveConnection:=oConn
' How to get the field names
'For col = 0 To .Fields.Count - 1
'Debug.Print .Fields(col).Name
'Next col
'MsgBox .RecordCount
' How to write the recordset to Excel method 1
'Range("A1").Offset(1, 0).CopyFromRecordset rs
' How to write the recordset to an array
'.MoveFirst
'a = .GetRows
' Below needs tweaking
'MsgBox "First Record's film_id: " & a(0, 0), , "Second Record's film_id: " & a(0, 1)
'MsgBox "First Record's title: " & a(1, 0), , "Second Record's title: " & a(1, 1)
If .RecordCount < 1 Then GoTo EndNow
' How to get records and field data values
'.MoveFirst
'For row = 0 To 0 '(.RecordCount - 1)
' For col = 0 To .Fields.Count - 1
' Debug.Print "Row: " & row, "Field: " & col, .Fields(col).Name, .Fields(col).Value
' Next col
' .MoveNext
'Next row
' How to iterate each row in a range, add those as new records, _
and add the field values from the column cells in the row
' How to add new records and field values from an Excel range
Set r = Worksheets(wsName).Range("A2:M" & _
Worksheets(wsName).Range("A" & Rows.Count).End(xlUp).row)
For Each row In r.Rows
' Create RecordSet of Primary Key to Check for Duplicates
Set rs2 = New ADODB.RecordSet
With rs2
' Record locking ' http://www.utteraccess.com/wiki/index.php?title=Beginners_Guide_To_ODBC
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockOptimistic
strSQL = "SELECT * FROM " & dbName & " WHERE film_id=" & row.Cells(1).Value2
.Open Source:=strSQL, ActiveConnection:=oConn
If rs2.RecordCount >= 1 Then
''Next two lines show how to skip the row if a duplicate key exists.
'Debug.Print row.Cells(1).Value2 & " is a duplicate. Record was not added."
'GoTo NextRow
Else: .AddNew
End If
End With
For Each c In row.Cells
If rs2.RecordCount >= 1 Then
' IF() check to avoid error due to foreign key constraint
If rs2.Fields(c.Column - 1).Name <> "original_language_id" Then _
rs2.Fields(c.Column - 1).Value = c.Value 'Fieldnames are 0-index based
Else
' IF() check to avoid error due to foreign key constraint
If .Fields(c.Column - 1).Name <> "original_language_id" Then _
.Fields(c.Column - 1).Value = c.Value 'Fieldnames are 0-index based
End If
Next c
.Update
If .RecordCount >= 1 Then rs2.Update
NextRow:
Next row
End With 'End rs object referencing
ErrHandler:
If Err.Description <> "" And Err.Source <> "" Then
MsgBox Err.Description, vbCritical, Err.Source
End If
EndNow:
Set rs = Nothing
Set rs2 = Nothing
oConn.Close
Set oConn = Nothing
End Sub