Wednesday 30 September 2015

Universal MySql Data exporter in Visual Basic.

http://www.hybridmindset.com/images/mysql_logo_small.jpg 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

No comments: