使用 VBA 执行在文本框中编写的 SQL答案

【问题标题】：Execute SQL written in a textbox with VBA使用 VBA 执行在文本框中编写的 SQL
【发布时间】：2020-12-29 22:02:09
【问题描述】：

关于这个问题：Avoid new line seperators in mySQL query within VBA code，我想执行一个SQL 语句，该语句写在 Excel 文件中的textbox 中。
因此，我创建了一个名为 SqlQuery1 的 textbox，如下所示：

在VBA中我指的是SqlString中的文本框：

Sub Get_Data_from_DWH ()

    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
        
    Set conn = New ADODB.Connection
    conn.ConnectionString = "DRIVER={MySQL ODBC 5.1 Driver}; SERVER=XX.XXX.XXX.XX; DATABASE=bi; UID=testuser; PWD=test; OPTION=3"
    conn.Open
    
    SqlString = ThisWorkbook.Sheet1.Shapes("SqlQuery1").OLEFormat.Object.Text
                            
    Set rs = New ADODB.Recordset
    rs.Open strSQL, conn, adOpenStatic

    Sheet1.Range("A1").CopyFromRecordset rs
    
    rs.Close
    conn.Close
    
End Sub

但是，我在SqlString 上收到了runtime error 438。
您知道我需要进行哪些更改才能使其正常工作吗？

【问题讨论】：

将有问题的代码字符串分成不同的步骤。 SET wbk = ThisWorkbook: SET sh = wbk.Sheet1: SET shp = sh.Shapes("SqlQuery1"): SET of = shp.OLEFormat: SET obj = of.Object: SET SqlString = obj.Text - 什么语句失败了？
'MySQL ODBC 5.1 Driver' 已经过时了。如果 MySQL 服务器是 5.6 或更高版本，请使用“MySQL ODBC 8.0 驱动程序”，因为 8.0.21 包含几个错误修复，例如参数。如果较旧的 MySQL Server 使用 5.3.14（支持 Server 4.1 到 5.7）

标签： mysql sql excel vba

【解决方案1】：

Thisworkbook.Sheet1 不是有效的对象路径，请尝试：

SqlString = ThisWorkbook.Sheets("Sheet1").Shapes("SqlQuery1").OLEFormat.Object.Text

或者只是

SqlString = Sheet1.Shapes("SqlQuery1").OLEFormat.Object.Text

并确保工作表明确命名为“Sheet1”

另外，你需要改变

rs.Open strSQL, conn, adOpenStatic

到这里：

rs.Open SqlString, conn, adOpenStatic

你可能应该使用

Dim SqlString as String

在例程开始时

【讨论】：

【解决方案2】：

您绝对是在正确的轨道上，我可以看到您已经尝试解决此错误！ :-)

据我所知，您的问题与 rs.Open 部分有关。我已经对您的代码进行了一些调整。据我所知，您没有添加 ADODB.Command 部分。我已经在下面的代码 sn-p 中添加了这个。

在较大的模块中节省时间的建议；在开始时将您的连接声明为私有全局字符串，以便稍后在模块中访问它。

Private Const CONNECTION As String = "DRIVER={MySQL ODBC 5.1 Driver}; SERVER=XX.XXX.XXX.XX; DATABASE=bi; UID=testuser; PWD=test; OPTION=3"
    
Sub Get_Data_from_DWH()


    Dim cmd As ADODB.Command
    Dim conn As ADODB.CONNECTION
    Dim rs As ADODB.Recordset

    
    Set conn = New ADODB.CONNECTION
    conn.Open CONNECTION
    conn.CommandTimeout = 900
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    
    
    If Not conn.State = ADODB.adStateOpen Then GoTo Bugcatcher
    
    Set cmd = New ADODB.Command
    cmd.ActiveConnection = CONNECTION
    cmd.CommandText = ws.Shapes("TextBox 2").OLEFormat.Object.Text
    cmd.CommandType = adCmdText
    
    Set rs = cmd.Execute
    
        
    ws.Range("A1").CopyFromRecordset rs
        
    
        
Bugcatcher:
        Exit Sub
        
    
End Sub

【讨论】：