Excel VBA:从MySQL数据库导入数据，无需其他引用或加载项

Question

我想将数据集从MySQL数据库导入Excel，而不使用额外的引用或加载项(这样同事们就可以在不更改设置的情况下使用它(。到目前为止，我发现的解决方案都使用了额外的引用或默认情况下不活动的东西。

该数据库包含越来越多的数据集，所有数据集都以标准化的方式命名，用户应该能够选择导入哪个数据集。我是一个VBA半傻瓜，已经设法获得了用于一个特定数据集的基本想法(使用宏编辑器(，但我无法使其用于可变数据集名称。

到目前为止，有效的方法如下(本例中的数据集名称为"scada_pl_oxidation_study_14102020"，数据库当前为本地数据库，但将来将更改为远程数据库(

'Insert table from MySQL database
Application.CutCopyMode = False
Sheets("Raw Data").Select
Range("A1").Select
ActiveWorkbook.Queries.Add Name:= _
"cndatabase scada_pl_oxidation_study_14102020", Formula:= _
"let" & Chr(13) & "" & Chr(10) & "    Source = MySQL.Database(""localhost"", ""cndatabase"", [ReturnSingleDatabase=true])," & Chr(13) & "" & Chr(10) & "    cndatabase_scada_pl_oxidation_study_14102020 = Source{[Schema=""cndatabase"",Item=""scada_pl_oxidation_study_14102020""]}[Data]" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    cndatabase_scada_pl_oxidation_study_14102020"
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""cndatabase scada_pl_oxidation_study_14102020"";Extended Pr" _
, "operties="""""), Destination:=Range("'Raw Data'!$A$3")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array( _
"SELECT * FROM [cndatabase scada_pl_oxidation_study_14102020]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "cndatabase_scada_pl_oxidation_study_14102020"
.Refresh BackgroundQuery:=False
End With

我最初的想法是使用Userform只键入要导入的数据集的名称，但替换"；scada_pl_oxidation_study_14102020"；使用基于Userform输入的变量似乎不起作用。用户可以从数据库中包含的数据集列表中进行选择的解决方案将是首选，但这远远超出了我的能力。有人能帮我吗？

Answer 1

">用户可以从包含的数据集列表中进行选择的解决方案在数据库中将优选"；

创建一个带有ListBox和CommandButton的UserForm，并将此代码放在表单上。当表单初始化时，它会用数据库中以单词"开头的所有表填充列表框；scada"；。选择一个表并按下它应该填充的按钮"；"原始数据"；包含所选表中记录的工作表。您必须根据现有的驱动程序修改DSNsless连接详细信息。

Option Explicit
Private Sub UserForm_Initialize()
Const FILTER = "scada*"
Dim conn, cmd, rs
Set conn = DbConnect()
Set cmd = CreateObject("ADODB.Command")
With cmd
.CommandType = 1 'adCmdText
.CommandText = "SHOW TABLES"
.ActiveConnection = conn
End With
' populate list box
UserForm1.ListBox1.Clear
Set rs = CreateObject("ADODB.Recordset")
Set rs = cmd.Execute
rs.MoveFirst
While Not rs.EOF
If LCase(rs(0)) Like LCase(FILTER) Then
UserForm1.ListBox1.AddItem rs(0)
End If
rs.MoveNext
Wend
conn.Close
End Sub
' select table
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim i As Long, sTable As String
Dim conn, cmd, rs

' select table
For i = 0 To ListBox1.ListCount
If ListBox1.Selected(i) Then sTable = ListBox1.List(i)
Next
If Len(sTable) = 0 Then Exit Sub

' connect to db
Set conn = DbConnect()
Set cmd = CreateObject("ADODB.Command")
With cmd
.CommandType = 1 'adCmdText
.CommandText = "SELECT * FROM " & sTable
.ActiveConnection = conn
End With
' run query
Set rs = CreateObject("ADODB.Recordset")
Set rs = cmd.Execute

' dump data to sheet
Set ws = ThisWorkbook.Sheets("Raw Data")
ws.Cells.Clear ' clear sheet
ws.Range("A3").CopyFromRecordset rs
conn.Close
End Sub
Function DbConnect() As Object

Const SERVER = "127.0.0.1" 'localhost
Const DB = "cndatabase"
Const UID = "****" ' user I suggest with SELECT only privilidges
Const PWD = "****" ' password
Set DbConnect = CreateObject("ADODB.Connection")
DbConnect.ConnectionString = "Driver={MySQL ODBC 8.0 ANSI Driver};" & _
"UID=" & UID & "; PWD=" & PWD & ";" & _
"SERVER=" & SERVER & ";" & _
"DATABASE=" & DB & ";" & _
"PORT=3306;" & _
"Initial Catalog=" & DB
DbConnect.Open

End Function