download certain tables from mysql server to particular location as csv files - excel

Question

connect to mysql database.
should give user input which table to download from database.
selected table should get downloaded to particular location and save as a csv file. note csv name should be tablename.csv.
Sub connect()
Dim Password As String
Dim SQLStr As String
'OMIT Dim Cn statement
Dim Server_Name As String
Dim User_ID As String
Dim Database_Name As String
'OMIT Dim rs statement
Set rs = CreateObject("ADODB.Recordset") 'EBGen-Daily
Server_Name = "localhost"
Database_Name = "testdb" ' Name of database
User = "root" 'id user or username
Password = "zxcasdQWE123" 'Password
SQLStr = "SELECT * FROM vector"
Set Cn = CreateObject("ADODB.Connection") 'NEW STATEMENT
Cn.Open "Driver={MySQL ODBC 8.0 Unicode Driver};Server=" & _
Server_Name & ";Database=" & Database_Name & _
";User=" & User & ";Password=" & Password & "; Option=3;"
rs.Open SQLStr, Cn, adOpenStatic
Dim myArray()
Dim ostream As Object
myArray = rs.GetRows()
kolumner = UBound(myArray, 1)
rader = UBound(myArray, 2)
Set ostream = CreateObject("ADODB.Stream")
ostream.Open
'ostream.WriteText "hi, hello" & vbNewLine & "how, are" ' test input. not for any use
ostream.SaveToFile ("C:\Users\asus\Downloads\vector.csv")
ostream.Close
rs.Close
Set rs = Nothing
Cn.Close
Set Cn = Nothing
End Sub
I have connected to my database and selected a table for eg and put into array. now i am struck with how to download that table as csv's. and make user input on which table to select from database.
Can anyone help me with it.

Answer 1

Create a new workbook, copy records to sheet using CopyFromRecordset and then save as CSV.
Option Explicit
Sub CreateCSV()
' logon credentials
Const Server_Name = "localhost"
Const Database_Name = "testdb" ' Name of database
Const User = "root" 'id user or username
Const Password = "zxcasdQWE123" 'Password
' connect
Dim Cn As Object, sCn As String, rs As Object
Set Cn = CreateObject("ADODB.Connection") 'NEW STATEMENT
Cn.Open "Driver={MySQL ODBC 8.0 Unicode Driver}" & _
";Server=" & Server_Name & ";Database=" & Database_Name & _
";User=" & User & ";Password=" & Password & "; Option=3;"
' get list of tables
Dim arTbl, n As Long, sTbl As String, msg As String, u As Variant
Set rs = Cn.Execute("SHOW TABLES")
arTbl = rs.getrows()
For n = 1 To UBound(arTbl, 2)
msg = msg & n & ") " & arTbl(0, n - 1) & vbLf
Next
u = InputBox(msg, "Select Table")
' check user input is valid
If IsNumeric(u) Then
If u < 1 Or u > UBound(arTbl, 2) Then
MsgBox u & " is an invalid entry !", vbExclamation
Exit Sub
End If
Else
MsgBox u & " is an invalid entry !", vbExclamation
Exit Sub
End If
' selected table
sTbl = arTbl(0, u - 1)
' execute query
Dim wbCSV As Workbook, wb As Workbook, filename As String
Set rs = Cn.Execute("SELECT * FROM " & sTbl)
' create workbook, save as csv
Set wb = ThisWorkbook
Set wbCSV = Workbooks.Add(1)
filename = wb.Path & "\" & sTbl & ".csv"
With wbCSV.Sheets(1)
' header
For n = 1 To rs.Fields.Count
.Cells(1, n) = rs.Fields(n - 1).Name
Next
' data
.Range("A2").CopyFromRecordset rs
n = .Cells(.Rows.Count, "A").End(xlUp).Row
.SaveAs filename, xlCSV
wbCSV.Close savechanges:=False
End With
MsgBox n - 1 & " rows exported to " & filename, vbInformation
End Sub