Microsoft provides a wonderfull tool called ActiveX Data Object which
is able to connect to any type of database through connection string.
All you need is proper driver for connectivity.
When we started developing this application we though to make it absolute
dynamic. That means you only provide database url, user name and password.
And when you connect you get all the schemas within the database. You select
any of the schema and click export, you are done. All the tables within the
schema will be exported in csv format to a folder located at the root of the
application. I am providing you the code. To make it simple I have put everything
within one form.
This the the form where you need to provide the ipaddress or url for MySql database server.
Then provide User Name, Password and click on connect. Combobox will be enabled and all
the shcemas will be populated into the combobox. Select your schema and click on export.
A folder will be created in the root of you application path and all tables will be exported as
CSV files.
The code is given below.
MySql ODBC driver 3.51 is required to connect to MySql database with this application.
If you haven't installed mysql odbc driver get it from here .
https://dev.mysql.com/downloads/connector/odbc/3.51.html
Also download the source code from Google Drive.
'------------------------------------------------------------------------------------------------------------
Option Explicit
Dim con As Object
Dim rs As Object, rs1 As Object
Private Sub ExportData()
Dim i As Integer
Dim table_name As String
Dim fld As String, rec As String
Dim cnt As Double, totcnt As Double
i = 0
Command1.Enabled = False
cnt = 0
Set rs = VBA.CreateObject("ADODB.Recordset")
Set rs1 = VBA.CreateObject("ADODB.Recordset")
If con.state = 1 Then con.Close
con.ConnectionString = "driver={MySQL ODBC 3.51 Driver};server=" & txtHostName.Text & ";" & _
"database=" & cmbDB.Text & ";Uid=" & txtUser.Text & ";Pwd=" & txtPasswd.Text & ";OPTION=3;"
con.Open
rs.Open "select count(distinct table_name) from information_schema.tables where table_schema = '" & cmbDB.Text & "'", con
totcnt = VBA.IIf(IsNull(rs(0)), 1, rs(0))
rs.Close
rs.Open "select distinct table_name from information_schema.tables where table_schema = '" & cmbDB.Text & "'", con
If Not rs.EOF Then List1.Clear
' totcnt = rs.RecordCount
While Not rs.EOF
Dim s As String
s = ""
table_name = VBA.IIf(IsNull(rs("TABLE_NAME")), "", rs("TABLE_NAME"))
If table_name <> "" Then
Call CreateFolder(cmbDB.Text)
Open App.Path & "\" & cmbDB.Text & "\" & table_name & ".csv" For Output As #1
If rs1.state = 1 Then rs1.Close
rs1.Open "select * from " & table_name & " order by 1", con, 2
fld = ""
For i = 0 To rs1.fields.Count - 1
fld = fld & rs1.fields(i).Name & ","
Next i
fld = VBA.Left$(fld, VBA.Len(fld) - 1)
Print #1, fld
While Not rs1.EOF
rec = ""
For i = 0 To rs1.fields.Count - 1
rec = rec & GetColumnValue(rs1, i, table_name) & ","
Next i
rec = VBA.Left$(rec, VBA.Len(rec) - 1)
Print #1, rec
rs1.MoveNext
DoEvents
Wend
Close #1
End If
rs.MoveNext
cnt = cnt + 1
lblPct.Caption = (cnt / totcnt) * 100 & "% Complete..."
lbl_progress.Caption = "Exporting table " & table_name & "...."
DoEvents
Wend
rs.Close
con.Close
Command1.Enabled = True
End Sub
Private Sub Command1_Click()
Call ExportData
End Sub
Private Sub Command2_Click()
con.ConnectionString = "driver={MySQL ODBC 3.51 Driver};server=" & txtHostName.Text & ";" & _
"database=mysql;Uid=" & txtUser.Text & ";Pwd=" & txtPasswd.Text & ";OPTION=3;"
con.Open
rs.Open "select distinct TABLE_SCHEMA from information_schema.tables order by 1", con, 2
cmbDB.Clear
While Not rs.EOF
cmbDB.AddItem GetColumnValue(rs, 0, "information_schema.tables")
rs.MoveNext
Wend
rs.Close
Command2.Enabled = False
Command1.Enabled = True
cmbDB.Enabled = True
End Sub
Private Sub Form_Load()
Set con = VBA.CreateObject("ADODB.Connection")
Set rs = VBA.CreateObject("ADODB.Recordset")
Set rs1 = VBA.CreateObject("ADODB.Recordset")
End Sub
Private Sub List1_Click()
Dim i As Integer
List2.Clear
rs.Open "select * from " & List1.List(List1.ListIndex), con, 2
For i = 0 To rs.fields.Count - 1
List2.AddItem rs.fields(i).Name
Next i
rs.Close
End Sub
Private Function GetColumnValue(r As Object, colIndex As Integer, tble_name As String) As String ', rowNum As Long) As String
On Error GoTo errs
GetColumnValue = VBA.IIf(IsNull(r(colIndex)), "", r(colIndex))
Exit Function
errs:
End Function
Private Sub CreateFolder(folderName As String)
Dim fs As Object
Set fs = VBA.CreateObject("Scripting.FileSystemObject")
If Not fs.FolderExists(App.Path & "\" & folderName) Then
Call fs.CreateFolder(App.Path & "\" & folderName)
End If
Set fs = Nothing
End Sub
is able to connect to any type of database through connection string.
All you need is proper driver for connectivity.
When we started developing this application we though to make it absolute
dynamic. That means you only provide database url, user name and password.
And when you connect you get all the schemas within the database. You select
any of the schema and click export, you are done. All the tables within the
schema will be exported in csv format to a folder located at the root of the
application. I am providing you the code. To make it simple I have put everything
within one form.
This the the form where you need to provide the ipaddress or url for MySql database server.
Then provide User Name, Password and click on connect. Combobox will be enabled and all
the shcemas will be populated into the combobox. Select your schema and click on export.
A folder will be created in the root of you application path and all tables will be exported as
CSV files.
The code is given below.
MySql ODBC driver 3.51 is required to connect to MySql database with this application.
If you haven't installed mysql odbc driver get it from here .
https://dev.mysql.com/downloads/connector/odbc/3.51.html
Also download the source code from Google Drive.
'------------------------------------------------------------------------------------------------------------
Option Explicit
Dim con As Object
Dim rs As Object, rs1 As Object
Private Sub ExportData()
Dim i As Integer
Dim table_name As String
Dim fld As String, rec As String
Dim cnt As Double, totcnt As Double
i = 0
Command1.Enabled = False
cnt = 0
Set rs = VBA.CreateObject("ADODB.Recordset")
Set rs1 = VBA.CreateObject("ADODB.Recordset")
If con.state = 1 Then con.Close
con.ConnectionString = "driver={MySQL ODBC 3.51 Driver};server=" & txtHostName.Text & ";" & _
"database=" & cmbDB.Text & ";Uid=" & txtUser.Text & ";Pwd=" & txtPasswd.Text & ";OPTION=3;"
con.Open
rs.Open "select count(distinct table_name) from information_schema.tables where table_schema = '" & cmbDB.Text & "'", con
totcnt = VBA.IIf(IsNull(rs(0)), 1, rs(0))
rs.Close
rs.Open "select distinct table_name from information_schema.tables where table_schema = '" & cmbDB.Text & "'", con
If Not rs.EOF Then List1.Clear
' totcnt = rs.RecordCount
While Not rs.EOF
Dim s As String
s = ""
table_name = VBA.IIf(IsNull(rs("TABLE_NAME")), "", rs("TABLE_NAME"))
If table_name <> "" Then
Call CreateFolder(cmbDB.Text)
Open App.Path & "\" & cmbDB.Text & "\" & table_name & ".csv" For Output As #1
If rs1.state = 1 Then rs1.Close
rs1.Open "select * from " & table_name & " order by 1", con, 2
fld = ""
For i = 0 To rs1.fields.Count - 1
fld = fld & rs1.fields(i).Name & ","
Next i
fld = VBA.Left$(fld, VBA.Len(fld) - 1)
Print #1, fld
While Not rs1.EOF
rec = ""
For i = 0 To rs1.fields.Count - 1
rec = rec & GetColumnValue(rs1, i, table_name) & ","
Next i
rec = VBA.Left$(rec, VBA.Len(rec) - 1)
Print #1, rec
rs1.MoveNext
DoEvents
Wend
Close #1
End If
rs.MoveNext
cnt = cnt + 1
lblPct.Caption = (cnt / totcnt) * 100 & "% Complete..."
lbl_progress.Caption = "Exporting table " & table_name & "...."
DoEvents
Wend
rs.Close
con.Close
Command1.Enabled = True
End Sub
Private Sub Command1_Click()
Call ExportData
End Sub
Private Sub Command2_Click()
con.ConnectionString = "driver={MySQL ODBC 3.51 Driver};server=" & txtHostName.Text & ";" & _
"database=mysql;Uid=" & txtUser.Text & ";Pwd=" & txtPasswd.Text & ";OPTION=3;"
con.Open
rs.Open "select distinct TABLE_SCHEMA from information_schema.tables order by 1", con, 2
cmbDB.Clear
While Not rs.EOF
cmbDB.AddItem GetColumnValue(rs, 0, "information_schema.tables")
rs.MoveNext
Wend
rs.Close
Command2.Enabled = False
Command1.Enabled = True
cmbDB.Enabled = True
End Sub
Private Sub Form_Load()
Set con = VBA.CreateObject("ADODB.Connection")
Set rs = VBA.CreateObject("ADODB.Recordset")
Set rs1 = VBA.CreateObject("ADODB.Recordset")
End Sub
Private Sub List1_Click()
Dim i As Integer
List2.Clear
rs.Open "select * from " & List1.List(List1.ListIndex), con, 2
For i = 0 To rs.fields.Count - 1
List2.AddItem rs.fields(i).Name
Next i
rs.Close
End Sub
Private Function GetColumnValue(r As Object, colIndex As Integer, tble_name As String) As String ', rowNum As Long) As String
On Error GoTo errs
GetColumnValue = VBA.IIf(IsNull(r(colIndex)), "", r(colIndex))
Exit Function
errs:
End Function
Private Sub CreateFolder(folderName As String)
Dim fs As Object
Set fs = VBA.CreateObject("Scripting.FileSystemObject")
If Not fs.FolderExists(App.Path & "\" & folderName) Then
Call fs.CreateFolder(App.Path & "\" & folderName)
End If
Set fs = Nothing
End Sub
No comments:
Post a Comment