You added the names of the columns in database mysql ?
You added the names of the columns in database mysql ?
Lets get some terminology straight.
Database=Excel:
Records=Rows
Fields=Columns
Fieldnames=Values in Columns for first row, usually.
Field Values=Column Values
The only way to really test for a Primary Key's field value being duplicated and causing an error, that I know of, would be to do another SQL and test for the value being duplicated to cause a recordcount of 0 (1 record) to be returned to the recordset.
Here is the final code using this 2nd method less the duplicate key check. Obviously, this fails on the 2nd run because the records were added in the first run. To update an existing record, requires more coding. You can learn alot from comments so I left those in. Delete those and you will see that there is not that much code there. It basically breaks down to (1) MySQL connection string and (2) adding rows as records.
Sub InsertIntoMySQL() ' 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 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=ken;" & _ "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 .AddNew For Each c In row.Cells 'Debug.Print row.row, c.Column - 1, .Fields(c.Column - 1).Name, c.Value ' 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 Next c Next row .Update 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 oConn.Close Set oConn = Nothing End Sub
step 1 i download InsertFilmRecordsIntoMySQL
step 2 i change password "PASSWORD=ken
step 3 i add new database Sakila
step 4 i add name name taple film
step 5 i add names columns in database Sakila
step 6 i run macro InsertIntoMySQL
where wrong ?
0. Open the workbook that I attached.
1. Change the connection strings as you did in the other examples.
2. Run Sub InsertIntoMySQL
If/When you run into problems running a Sub, use F8 to debug one line at a time to see where the problem lies.
Obviously, sakila.film should exist. If not, you will have to create it. It is a common database which you can download if needed.
Ignore this for now but here is a simple 3rd insert records method. With the issue of the foreign key in sakila.film and such, it will have limited use. Obviously, it needs some work to work in sakila.film but the concept is sound. You can see how simple it is. The biggest part is just setting some data up for insertion into nwind.Employees. Notice that Column names match Field names.
The second method offers the most flexibility.
Sub demo() Dim objRS As Object, nwindPath As String Set objRS = CreateObject("ADODB.Recordset") nwindPath = ThisWorkbook.Path & "\nwind.mdb" Dim r As Range [a1] = "LastName" [b1] = "FirstName" [a2] = "Hobson" [b2] = "Kenneth" Set r = [a1:b2] r.Name = "MyRange" objRS.Open "INSERT INTO Employees SELECT * FROM [MyRange] IN '" & ThisWorkbook.FullName & "' 'Excel 8.0;'", _ "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & nwindPath Set objRS = Nothing End Sub
Thank you Kenneth HopsOriginally Posted by Kenneth Hobs
This code working but the same problem sheet InsertIntoMySQL repeats rows every time run macro
Your comment was already addressed in post 42.
Obviously, this fails on the 2nd run because the records were added in the first run.
i can export database access to mysql from excel by vba code ?
I mean link excel to access and export database access to database mysql by use vba code in excel
You lost me. I have no idea what you mean in post 48. All that should be in a new thread.
In this example, it skips adding a record to sakila.film if the Primary key value for a row (column 1) in Excel data exists in sakila.film. If you want to update the data based on existing Primary key value then other code is needed.
Sub InsertIntoMySQL() ' 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 film_id FROM " & dbName & " WHERE film_id=" & row.Cells(1).Value2 .Open Source:=strSQL, ActiveConnection:=oConn If rs2.RecordCount >= 1 Then Debug.Print row.Cells(1).Value2 & " is a duplicate. Record was not added." GoTo NextRow End If End With .AddNew For Each c In row.Cells 'Debug.Print row.row, c.Column - 1, .Fields(c.Column - 1).Name, c.Value ' 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 Next c .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
Please repair this file
and send me backup database
I don't work with MySQL databases that much. Creating one from scratch does not really solve anything. If that is your goal, as I advised before, go to a MySQL forum, or post in a new thread if the goal is to create a new MySQL database by VBA code alone.
If you do not like the help that you have received here, below are some other forums that I like. Some respondents in the other forums will know more than I know about MySQL. Note: do not crosspost, see this link about cross-posting: http://www.excelguru.ca/node/7
A few Excel VBA forums:
1. http://www.excelforum.com/forumdisplay.php?f=7
2. http://www.mrexcel.com/forum/excel-questions/
3. http://www.ozgrid.com/forum/forumdisplay.php?f=8
4. many more....
Several people that help the most in the forums do not like to read and respond to the same request for help when they visit several forums, ergo my link about cross-posting.
I solved the problem in this thread using 3 methods. I used two tables in one standard database, sakila, for two specific solutions. Each database and tables have different constraints so I can only show you some things. Try to learn the concepts so that you can apply them to fit your needs.
The only thing really left is how to update records if a duplicate key exists. My last code just skips adding a duplicate key record which avoids the error message.
I don't have time to address in-depth issues in PM's, real-time chat, or skype. Most forums discourage that as the replies are meant to not only help the original poster (OP) but other users with the same problem. You may need to hire a consultant if you want instant help.
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
Posting Permissions
Reply With Quote
