You added the names of the columns in database mysql ?
Printable View
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.
Code: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.
Code: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 HopsQuote:
Originally Posted by Kenneth Hobs
This code working but the same problem sheet InsertIntoMySQL repeats rows every time run macro
:cry:
Your comment was already addressed in post 42.
Quote:
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.
Code: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.
Code: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