使用VBA通过持久连接从MySQL取数时遇‘对象要求’错误求助

问题描述 #

尝试实现VBA与MySQL的持久连接，工作簿打开时连接可正常建立，但获取数据或关闭工作簿时出现**‘对象要求’**错误；从用户窗体运行取数代码时，第2行执行失败。

相关代码 #

连接代码（原） #

Public objcnn As ADODB.Connection

Public Sub MySQL_Login()
    Set objcnn = New ADODB.Connection
    objcnn.Open "Driver={MySQL ODBC 9.1 ANSI Driver};Server=localhost; Database=******; UID=******; PWD=******"
       
End Sub

Private Sub Workbook_Open()
    MySQL_Login
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'    objcnn.Close
End Sub

取数代码（第2行执行失败） #

If ReportCon.Mpa_R.value <> "" And count = "1" Then
    Set objRmp = objcnn.Execute("select * from con_res_hed where mpa = '" & mparep & "' and date_cast >= '" & startdate & "' and date_cast <= '" & enddate & "' order by report_nr;")
    Sheets("ReportCon").Range("A8").CopyFromRecordset objRmp
    Set objRmp = objcnn.Execute("Select  weight1_7, weight2_7, weight3_7, dens1_7, dens2_7, dens3_7, mpa1_7, mpa2_7, mpa3_7, mpaA_7, weight1_28, weight2_28, weight3_28, dens1_28, dens2_28, dens3_28, mpa1_28, mpa2_28, mpa3_28, mpaA_28 " & _
                "From con_res_data " & _
                "Left join con_res_hed on con_res_data.report_nr = con_res_hed.report_nr " & _
                "Where con_res_hed.mpa = '" & mparep & "' and date_cast >= '" & startdate & "' and date_cast <= '" & enddate & "' " & _
                "Order by con_res_hed.report_nr;")
    Sheets("ReportCon").Range("L8").CopyFromRecordset objRmp
    ReportCon.Mpa_R.value = ""
    ReportCon.Start_date.value = ""
    ReportCon.End_Date.value = ""
    ReportCon.Rep_search.Enabled = False
    ReportCon.Report_Num.SetFocus
Else

解决步骤 #

1. 修正全局变量作用域 #

原连接代码放在ThisWorkbook模块中，全局变量objcnn的作用域仅局限于该模块，用户窗体无法直接访问。

• 新建一个标准模块（如Module1），将objcnn的声明和MySQL_Login过程移动到该模块中，确保整个VBA项目都能访问该连接对象。

2. 增加连接错误处理 #

在MySQL_Login中添加错误捕获，确认连接是否成功建立，避免objcnn为Nothing：

Public objcnn As ADODB.Connection

Public Sub MySQL_Login()
    On Error GoTo ConnError
    Set objcnn = New ADODB.Connection
    objcnn.Open "Driver={MySQL ODBC 9.1 ANSI Driver};Server=localhost; Database=******; UID=******; PWD=******"
    Exit Sub
ConnError:
    MsgBox "连接失败：" & Err.Description, vbCritical
    Set objcnn = Nothing
End Sub

3. 取数前验证连接状态 #

在取数代码开头添加判断，确保objcnn已存在且处于打开状态：

' 取数代码开头新增
If objcnn Is Nothing Or objcnn.State <> 1 Then ' 1对应adStateOpen常量
    MySQL_Login
    If objcnn Is Nothing Then Exit Sub ' 连接失败则退出
End If

If ReportCon.Mpa_R.value <> "" And count = "1" Then
    ' 原取数逻辑...

4. 安全关闭连接 #

取消Workbook_BeforeClose中的注释，增加对象存在性判断，避免关闭不存在的对象：

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If Not objcnn Is Nothing Then
        If objcnn.State = 1 Then objcnn.Close
        Set objcnn = Nothing
    End If
End Sub

5. 优化SQL查询（避免语法错误与注入） #

原代码用字符串拼接SQL，易因特殊字符或日期格式导致语法错误，改用参数化查询：

Set objRmp = Nothing
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
cmd.ActiveConnection = objcnn
cmd.CommandText = "select * from con_res_hed where mpa = ? and date_cast >= ? and date_cast <= ? order by report_nr;"
' 添加参数
cmd.Parameters.Append cmd.CreateParameter("mpa", 200, 1, 50, mparep) ' adVarChar=200, adParamInput=1
cmd.Parameters.Append cmd.CreateParameter("startdate", 7, 1, , startdate) ' adDate=7
cmd.Parameters.Append cmd.CreateParameter("enddate", 7, 1, , enddate)
Set objRmp = cmd.Execute
Sheets("ReportCon").Range("A8").CopyFromRecordset objRmp

内容的提问来源于stack exchange，提问作者Karl Goddard