vba code import table excel to mysql

[etheer]

Hi
I looking for vba code import table excel to mysql

[mancubus]

hi.

see if one of these helps...

http://www.vbaexpress.com/forum/showthread.php?t=8361
http://www.connectionstrings.com/questions/961/how-to-export-excel-worksheet-to-mysql-db-with-vba/
http://www.ozgrid.com/forum/showthread.php?t=21829

[etheer]

do not work all code

i need export all table sheet to datebase mysql using odbc by vba code

[Kenneth Hobs]

Post your code and we can help. The 2nd link provided should be enough to get you going. It is not formatted properly but if you copy the code above that code box and the code in the code box, you will be close to a solution for one sheet. Obviously, you must change the sheet name and other connections details.

Once you get it to work for one sheet, we can show you how to iterate all sheets. Keep in mind that databases are structured. Excel data is not always in nice structure ready for exporting. Short and simple files help us help you.

[etheer]

Dim oConn As ADODB.Connection Dim rs As ADODB.Recordset
'remove dangerous characters Function esc(txt As String) esc = Trim(Replace(txt, "'", "\'")) End Function
Private Sub cmdInsertData_Click() On Error GoTo ErrHandler Set rs = New ADODB.Recordset Set oConn = New ADODB.Connection oConn.Open "DRIVER={MySQL ODBC 5.1 Driver};" & _ "SERVER=myserver;" & _ "DATABASE=mydatabase;" & _ "USER=myuser;" & _ "PASSWORD=mypassword;" & _ "Option=3"
'number of rows with records
Dim height As Integer
height = Worksheets("myworksheet").UsedRange.Rows.Count

'insert data into SQL table
With Worksheets("myworksheet")
Dim rowtable As Integer
Dim strSQL As String
For rowtable = 2 To height
strSQL = "INSERT INTO mysqltable (column1, column2, column3) " & _
"VALUES ('" & esc(Trim(.Cells(rowtable, 1).Value)) & "', '" & _
esc(Trim(.Cells(rowtable, 2).Value)) & "', '" & _
esc(Trim(.Cells(rowtable, 3).Value)) & "')"
rs.Open strSQL, oConn, adOpenDynamic, adLockOptimistic
Next rowtable
End With

MsgBox "Insert with success " & Trim(Str(rowtable - 2)) & " records", vbInformation, "Verification Data Entry"


This code i need fix it

[Kenneth Hobs]

When posting code, be sure to post between code tags. You can click the # icon to insert codes. Most forums work like this.

I modified that code to fix some problems that might arise. Even so, I have not tested it as I usually do as I don't have a MySQL database setup.

Be sure to:
1. Add the ADO object as I commented.
2. Change the username, password, and database connection values.
3. Change Sheet1 if needed.


Sub InsertIntoMySQL()
Dim height As Long
Dim rowtable As Long
Dim strSQL As String
' 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

On Error GoTo ErrHandler
Set rs = New ADODB.Recordset
Set oConn = New ADODB.Connection
oConn.Open "DRIVER={MySQL ODBC 5.1 Driver};" & _
"SERVER=myserver;" & _
"DATABASE=mydatabase;" & _
"USER=myuser;" & _
"PASSWORD=mypassword;" & _
"Option=3"

'number of rows with records
height = Worksheets("myworksheet").UsedRange.Rows.Count

'insert data into SQL table
With Worksheets("Sheet1")
For rowtable = 2 To height
strSQL = "INSERT INTO mysqltable (column1, column2, column3) " & _
"VALUES ('" & esc(Trim(.Cells(rowtable, 1).Value)) & "', '" & _
esc(Trim(.Cells(rowtable, 2).Value)) & "', '" & _
esc(Trim(.Cells(rowtable, 3).Value)) & "')"
rs.Open strSQL, oConn, adOpenDynamic, adLockOptimistic
Next rowtable
End With
MsgBox "Insert with success " & Trim(Str(rowtable - 2)) & " records", _
vbInformation, "Verification Data Entry"

ErrHandler:
If Err.Description <> "" And Err.Source <> "" Then
MsgBox Err.Description, vbCritical, Err.Source
End If
End Sub

'remove dangerous characters
Function esc(txt As String)
esc = Trim(Replace(txt, "'", "\'"))
End Function

[etheer]

Thank you so much Kenneth Hobs

I got an error message

subscript out of range

[Kenneth Hobs]

3. Change Sheet1 if needed.

[etheer]

error message

subscript out of range

[Kenneth Hobs]

For the third time, you MUST change your sheet name.
Change:

With Worksheets("Sheet1")
to

With Worksheets("A1")

[etheer]

Still the problem error message subscript out of range

You can fix Book15.xlsm and upload it

[Kenneth Hobs]

Did you replace the sheetname as I explained? I can only do so much for you as I don't have your MySQL database.

Use F8 to debug one line at a time in the Visual Basic Editor (VBE). Hover your cursor over variables to see what they resolve to. Post what line of code causes problems.

When posting code with username or passwords, be sure obfuscate your data.

[Aussiebear]

Does your code error out on this line?


height = Worksheets("myworksheet").UsedRange.Rows.Count

I've looked at your workbook and there is no sheet named "my worksheet"

[etheer]

I edit this code

height = Worksheets("myworksheet").UsedRange.Rows.Count

To
height = Worksheets("M1").UsedRange.Rows.Count

I got error message

ODBC driver does not support the required properties

[Kenneth Hobs]

Is your computer 64 bit? If so, see this: http://www.connectionstrings.com/mysql-connector-odbc-5-1/

I suggest that you insert the code into a Module object, not the Sheet object.

[Aussiebear]

Have you added the ADO reference
Microsoft ActiveX Data Objects 2.8 Library?

[etheer]

Have you added the ADO reference
Microsoft ActiveX Data Objects 2.8 Library?


Yes i add Microsoft ActiveX Data Objects 2.8 Library

[etheer]

Impossible to export Excel sheet in database mysql by vba code ?

[Kenneth Hobs]

Is your computer 64 bit?

[etheer]

32bit

windows 7 ultimate service pack 1 86 x

microsoft office 2010

i can export access to mysql by odbc 5.1

kenneth hobs please you test code on website

http://www.db4free.net

[Kenneth Hobs]

That requires some other work to make that connection.

When I get time, I will run a test on my localhost MySQL at home. My work day will be long tomorrow so it may be two days before I get back to this. I work with 64 bit at home so I may have to play with the connection string.

When learning a method, try to keep it simple. Try working with the Sakila database and the Actor table. Make a short 2 or 3 rows in Excel to insert into Actor.

If you installed the workbench, maybe you installed MySQL for Excel? It is in the Data ribbon when installed. Manually using it appends Excel data to your MySQL quickly.
http://dev.mysql.com/doc/mysql-for-excel/en/

[etheer]

:banghead::banghead::banghead:

:cry:

[etheer]

Please help me

[Kenneth Hobs]

First off, you need to make sure that you have the MySQL ODBC driver installed. I have a macro that can show you but you can check it manually in the registry. Look for the name in the registry key, ODBC Drivers. On the computer that I tested this on, notice the driver name.

You need to install the Sakila database for this example. Change the password, ken, to yours. I did not try the Unicode ODBC driver. I just used ANSI for this example. Actors has 200 records. I changed the height to 3 so rows 2 to 3 or 2 rows/records were inserted into Sakila's table Actor. After running this, Actors will have 202 records.

I commented a link the shows a problem using Insert with Open. I just used Execute. The links shows another way to do it.

It took awhile to get MySQL installed and verify that the proper drivers were installed as well. Now you have a 100% tested solution as I would normally post.

Sub InsertIntoMySQL()
Dim height As Long
Dim rowtable As Long
Dim strSQL As String
' 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

On Error GoTo ErrHandler
Set rs = New ADODB.Recordset
Set oConn = New ADODB.Connection
' http://www.connectionstrings.com/mysql-connector-odbc-5-1/
' ODBC Drivers: http://dev.mysql.com/downloads/connector/odbc/
oConn.Open "DRIVER={MySQL ODBC 5.2 ANSI Driver};" & _
"SERVER=localhost;" & _
"DATABASE=Sakila;" & _
"USER=root;" & _
"PASSWORD=ken;" & _
"Option=3"

'number of rows with records
height = Worksheets("Sheet1").UsedRange.Rows.Count
height = 3

'insert data into SQL table
With Worksheets("Sheet1")
For rowtable = 2 To height
strSQL = "INSERT INTO actor (actor_id, first_name, last_name) " & _
"VALUES ('" & esc(Trim(.Cells(rowtable, 1).Value)) & "', '" & _
esc(Trim(.Cells(rowtable, 2).Value)) & "', '" & _
esc(Trim(.Cells(rowtable, 3).Value)) & "')"
'rs.Open strSQL, oConn, adOpenDynamic, adLockOptimistic
'http://stackoverflow.com/questions/2821917/connecting-to-mysql-from-excel-odbc-driver-does-not-support-the-requested-prope
oConn.Execute strSQL
Next rowtable
End With
MsgBox "Insert with success " & Trim(Str(rowtable - 2)) & " records", _
vbInformation, "Verification Data Entry"

ErrHandler:
If Err.Description <> "" And Err.Source <> "" Then
MsgBox Err.Description, vbCritical, Err.Source
End If
End Sub

'remove dangerous characters
Function esc(txt As String)
esc = Trim(Replace(txt, "'", "\'"))
End Function

[etheer]

Error

10401

[Kenneth Hobs]

It "errors" because the table Actor does not exist. When you manually look at the table Actor in Workbench, is it there?
Obviously, you are not running the code from a locally installed server.

I tried to setup a web MySQL database at the link db4free.net but was never sent an email detailing that it was setup. I may try again.

Post connection details to your web test Sakila database or PM details to me.

I am running mysqld version 5.6.13.

[etheer]

Thank you so much Kenneth Hobs
Now working code
10402

[etheer]

10403

[etheer]

But problem repeating rows when update sheet
10404

Please help me i need update rows every time run the macro not the write new rows

[etheer]

10407

[Kenneth Hobs]

Please mark this thread solved.

I am not sure how you added duplicate records. Actor_id is a primary key for that reason. It should have errored.

Copy the link to this thread and post a new one if you need help using Update in ADO. Most any SQL forum can provide that help. There are several Excel forum posts about ADO with Update that should suffice.

[etheer]

10407

The problem is repeating rows ever time run the macro

[etheer]

How insert column A To column AJ
cell 1 to 164


'insert data into SQL table
With Worksheets("M1")
For rowtable = 2 To height
strSQL = "INSERT INTO M1 (A, B, C) " & _
"VALUES ('" & esc(Trim(.Cells(rowtable, 1).Value)) & "', '" & _
esc(Trim(.Cells(rowtable, 2).Value)) & "', '" & _
esc(Trim(.Cells(rowtable, 3).Value)) & "')"

[Kenneth Hobs]

Add a loop within a loop. The example only has 3 fieldnames/columnnames. You can reference a fieldname by index number to match a column number but I don't recommend that. You can put all fieldnames into an array and iterate that in a loop. I do recommend that method. The index of those array elements should be set the same as the column numbers.

Try this at your own risk (untested).


Sub InsertIntoMySQL2()
Dim height As Long
Dim rowtable As Long
Dim strSQL As String
' 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 i As Integer, s as string

On Error GoTo ErrHandler
Set rs = New ADODB.Recordset
Set oConn = New ADODB.Connection
' http://www.connectionstrings.com/mysql-connector-odbc-5-1/
' ODBC Drivers: http://dev.mysql.com/downloads/connector/odbc/
oConn.Open "DRIVER={MySQL ODBC 5.2 ANSI Driver};" & _
"SERVER=localhost;" & _
"DATABASE=etheer;" & _
"USER=root;" & _
"PASSWORD=1234;" & _
"Option=3"

'number of rows with records
height = Worksheets("M1").UsedRange.Rows.Count
'height = 3

'insert data into SQL table
With Worksheets("M1")
For rowtable = 2 To height
s = "INSERT INTO M1 " & _
"VALUES "
For i = 1 To 35
strSQL = strSQL & "('" & esc(Trim(.Cells(rowtable, i).Value)) & "',"
Next i
strSQL = s & strSQL & "('" & esc(Trim(.Cells(rowtable, 36).Value)) & "')"
oConn.Execute strSQL
Next rowtable
End With
MsgBox "Insert with success " & Trim(Str(rowtable - 2)) & " records", _
vbInformation, "Verification Data Entry"

ErrHandler:
If Err.Description <> "" And Err.Source <> "" Then
MsgBox Err.Description, vbCritical, Err.Source
End If
End Sub

[etheer]

Error message

Compile error
Sup or Function not defined

[Kenneth Hobs]

To use the first SQL Insert method, you need to know the fieldnames. That string can be large so it may not be that efficient.

I don't have time to finish this 2nd method right now. It needs the loop to add the Excel rows from Height as records. In the loop, use rs.AddNew, iterate through each fieldname in the recordset, and add field values. I added a loop and debug.print to show you how to do these things. After adding the field values for a new record in the range loop, use rs.Update to update the record set. I will finish this when I get time. This method is similar to what I posted in a recent thread. That user was able to gleam what he needed.


' http://www.utteraccess.com/forum/lofiversion/index.php/t1947720.html

Sub InsertIntoMySQL()
Dim height As Long
Dim rowtable As Long, row As Long
Dim strSQL As String
' 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, wsName As String, dbName As String
Dim a As Variant

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"

'number of rows with records
height = Worksheets(wsName).UsedRange.Rows.Count
'height = 3

' Create RecordSet
Set rs = New ADODB.RecordSet
' Record locking ' http://www.utteraccess.com/wiki/index.php?title=Beginners_Guide_To_ODBC
rs.CursorLocation = adUseClient
rs.CursorType = adOpenStatic
rs.LockType = adLockOptimistic

With rs
strSQL = "SELECT * FROM " & dbName
rs.Open Source:=strSQL, ActiveConnection:=oConn
' Write the field names
For col = 0 To .Fields.Count - 1
'Debug.Print rs.Fields(col).Name
Next col
MsgBox rs.RecordCount

' Write the recordset
'Range("A1").Offset(1, 0).CopyFromRecordset rs
.MoveFirst
a = rs.GetRows
'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
.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
End With

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

I inserted the first 3 records from sakila.film database in, https://app.box.com/s/dzbthvp7sn50q9eaijaj. I just changed the film_id autoincrement values. If those 3 records can be updated, you will be set. Notice in the example that you can add field values by using the field's name or the 0-based index for the field.

This will then give you two ways to Insert records once I finish the range loop.

[etheer]

10429


Records 0

[etheer]

10430

when run macro reading database but does not writing

[etheer]

Error message

either bof or eof is true or the current record has been deleted

[Kenneth Hobs]

It needs the loop to add the Excel rows from Height as records.

I do not get any error on multiple runs of Sub InsertIntoMySQL. The other Sub in the other Module was the code to the link that I referenced way back in this thread. The MsgBox shows 1000 records in sakila.film. The Immediate window shows the first records values for each field. From that, you should be able to gleam how to iterate records and fields names and update from there. As I said, when I get time, I will add those few lines of code to do it.

Row: 0 Field: 0 film_id 1
Row: 0 Field: 1 title ACADEMY DINOSAUR
Row: 0 Field: 2 description A Epic Drama of a Feminist And a Mad Scientist who must Battle a Teacher in The Canadian Rockies
Row: 0 Field: 3 release_year 2006
Row: 0 Field: 4 language_id 1
Row: 0 Field: 5 original_language_id Null
Row: 0 Field: 6 rental_duration 6
Row: 0 Field: 7 rental_rate 0.99
Row: 0 Field: 8 length 86
Row: 0 Field: 9 replacement_cost 20.99
Row: 0 Field: 10 rating PG
Row: 0 Field: 11 special_features Deleted Scenes,Behind the Scenes
Row: 0 Field: 12 last_update 2/15/2006 5:03:42 AM

[etheer]

You added the names of the columns in database mysql ?

[Kenneth Hobs]

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

[etheer]

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 ?

[Kenneth Hobs]

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.

[Kenneth Hobs]

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

[etheer]

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

Thank you Kenneth Hops
This code working but the same problem sheet InsertIntoMySQL repeats rows every time run macro
:cry:

[Kenneth Hobs]

Your comment was already addressed in post 42.

Obviously, this fails on the 2nd run because the records were added in the first run.

[etheer]

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

[Kenneth Hobs]

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

[etheer]

Please repair this file

and send me backup database

[Kenneth Hobs]

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.

[Kenneth Hobs]

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