从 VBA Excel 2007 打开到 MySQL 的连接

Open connection to MySQL from VBA Excel 2007

提问by

I got this error when try to connect Excel and MySQL using ODBC

尝试使用 ODBC 连接 Excel 和 MySQL 时出现此错误

DataSource name not found and no default driver specified

未找到数据源名称且未指定默认驱动程序

Here is my VBA code:

这是我的 VBA 代码：

Sub test123()

  ' Connection variables
  Dim conn As New ADODB.Connection
  Dim server_name As String
  Dim database_name As String
  Dim user_id As String
  Dim password As String

  ' Table action variables
  Dim i As Long ' counter
  Dim sqlstr As String ' SQL to perform various actions
  Dim table1 As String, table2 As String
  Dim field1 As String, field2 As String
  Dim rs As ADODB.Recordset
  Dim vtype As Variant

  '----------------------------------------------------------------------
  ' Establish connection to the database
  server_name = "127.0.0.1" ' Enter your server name here - if running from a local       computer use 127.0.0.1
  database_name = "smss" ' Enter your database name here
  user_id = "root" ' enter your user ID here
  password = "" ' Enter your password here

  Set conn = New ADODB.Connection
  conn.Open "DRIVER={MySQL ODBC 5.2a Driver}" _
    & ";SERVER=" & server_name _
    & ";DATABASE=" & database_name _
    & ";UID=" & user_id _
    & ";PWD=" & password _

  ' Extract MySQL table data to first worksheet in the workbook
  GoTo skipextract
  Set rs = New ADODB.Recordset
  sqlstr = "SELECT * FROM inbox" ' extracts all data
  rs.Open sqlstr, conn, adOpenStatic
  With Sheet1(1).Cells ' Enter your sheet name and range here
    .ClearContents
    .CopyFromRecordset rs
  End With
  skipextract:

End Sub

I've added references (tools-reference)

我添加了参考（工具参考）

The ODBC driver also has been installed.

ODBC 驱动程序也已安装。

What is actually wrong? Thank you.

实际上有什么问题？谢谢你。

回答by Floris

There are many articles on this site describing similar problems. In particular, there were a couple of pointers in this linkthat rang true.

这个网站上有很多文章描述了类似的问题。特别是，此链接中有几个指针是正确的。

In your code above, one line in particular struck me as troublesome:

在你上面的代码中，有一行特别让我觉得很麻烦：

Dim conn As New ADODB.Connection

followed lower down by

其次是

Set conn = New ADODB.Connection

The second overrides the first in a way that makes me, for one, uncomfortable - although I can't tell you exactly what is wrong, except that you're creating TWO New Connections...

第二个以一种让我感到不舒服的方式覆盖了第一个 - 尽管我无法确切地告诉您出了什么问题，除了您正在创建两个新连接......

Try that - and the other fixes recommended in the linked article. Good luck.

试试这个 - 以及链接文章中推荐的其他修复。祝你好运。

回答by Krish

maybe this might help you/others:

也许这可能会帮助您/其他人：

Add this reference to your project: Microsoft ActiveX Data object 2 (or any higher version you have)

将此引用添加到您的项目：Microsoft ActiveX Data object 2（或您拥有的任何更高版本）

Throw this code into a module and save it: Edit the server details in this module.

将此代码放入模块并保存：在此模块中编辑服务器详细信息。

'---------------------------------------------------------------------------------------
' Module     : Mod_Connection
' Author     : Krish km, xkrishx.wordpress.com
' Date       : 27/08/2014
' Purpose    : use this for build mysql connectin string.
' Declaration: ? Krish KM, 2014.
'            : Free to modify and re-use as long as a clear credit is made about the orgin of the code and the link above
'            : This script is distributed in the hope that it will be useful,
'            : but WITHOUT ANY WARRANTY; without even the implied warranty of
'            : MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'            : GNU General Public License for more details.
'---------------------------------------------------------------------------------------

Option Explicit
Public ConnectionString As String
Private Const HKEY_LOCAL_MACHINE = &H80000002


Public Function GET_CURRENT_DRIVER() As String
'---------------------------------------------------------------------------------------
' Procedure : GET_CURRENT_DRIVER
' Author    : Krish km
' Date      : 27/08/2014
' Purpose   : This function returns available mysql odbc drivers found in the registry. You could search by MySQL ODBC and get the first result
'           : but I prefer prioritize the drivers i would like to yield first
'---------------------------------------------------------------------------------------
'
    If FIND_ODBC_DRIVER(GET_ODBC_DRIVER_NAMES, "MySQL ODBC 5.2 Unicode Driver") <> "" Then
        GET_CURRENT_DRIVER = "MySQL ODBC 5.2 Unicode Driver"
    ElseIf FIND_ODBC_DRIVER(GET_ODBC_DRIVER_NAMES, "MySQL ODBC 5.2w Driver") <> "" Then
        GET_CURRENT_DRIVER = "MySQL ODBC 5.2w Driver"
    Else
        GET_CURRENT_DRIVER = FIND_ODBC_DRIVER(GET_ODBC_DRIVER_NAMES, "MySQL ODBC")
    End If

End Function

Public Function GET_CONNECTION_STRING() As String
'---------------------------------------------------------------------------------------
' Procedure : GET_CONNECTION_STRING
' Author    : Krish KM
' Date      : 27/08/2014
' Purpose   : Returns MySQL connection string
'---------------------------------------------------------------------------------------
'        
    If Not ConnectionString = vbNullString Then
        GET_CONNECTION_STRING = ConnectionString
    Else

        Dim Driver As String
        Dim mDatabase As String
        Dim mServer As String
        Dim mUser As String
        Dim mPassword As String
        Dim mPort As Integer

        mDatabase = ""          ' DB name
        mServer = ""            ' Server name
        mUser = ""              ' DB user name
        mPassword = ""          ' DB user password
        mPort = 3306            ' DB port

        Driver = GET_CURRENT_DRIVER
        If Driver = "" Then
            Err.Raise 1, Err.Source, "MYSQL ODBC drivers are missing"
            Exit Function
        End If
        ConnectionString = "DRIVER={" & Driver & "};PORT=" & mPort & ";DATABASE=" & mDatabase & ";SERVER={" & mServer & "};UID=" & mUser & ";PWD={" & mPassword & "};"
        GET_CONNECTION_STRING = ConnectionString
    End If
End Function

Public Function GET_ODBC_DRIVER_NAMES()
'---------------------------------------------------------------------------------------
' Procedure : GET_ODBC_DRIVER_NAMES
' Author    : Krish KM
' Date      : 27/08/2014
' Purpose   : Checks in the registry for any odbc driver signatures and returns the collection
'---------------------------------------------------------------------------------------
'
    Dim strComputer As String, strKeyPath As String
    Dim objRegistry As Object, arrValueNames, arrValueTypes
    strComputer = "."
    strKeyPath = "SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers"
    Set objRegistry = GetObject("winmgmts:\" & strComputer & "\root\default:StdRegProv")
    objRegistry.EnumValues HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames, arrValueTypes
    GET_ODBC_DRIVER_NAMES = arrValueNames
End Function

Public Function FIND_ODBC_DRIVER(ByVal iArr, ByVal sValue) As String
'---------------------------------------------------------------------------------------
' Procedure : FIND_ODBC_DRIVER
' Author    : Krish KM
' Date      : 27/08/2014
' Purpose   : Simple array function to check if a specific value exists. if yes return the value if not return empty string
'---------------------------------------------------------------------------------------
'
    FIND_ODBC_DRIVER = ""
    Dim iValue As Variant
    For Each iValue In iArr
        If iValue = sValue Then
            FIND_ODBC_DRIVER = iValue
            Exit Function
        End If
    Next
End Function

Copy/modify this function on your excel sheet button/macro: update the SQL_GET statement as per your request/sql call.

在您的 Excel 工作表按钮/宏上复制/修改此函数：根据您的请求/sql 调用更新 SQL_GET 语句。

Sub Retrieve_EMP_Details()
'---------------------------------------------------------------------------------------
' Procedure : Retrieve_EMP_Details
' Author    : Krish KM
' Date      : 27/08/2014
' Purpose   : connects to the database and retrieves employee details.
'---------------------------------------------------------------------------------------
'

    'Connection variables
    Dim conn As New ADODB.Connection
    Dim cmd As New ADODB.Command
    Dim rs As ADODB.Recordset

    'Get connection string and connect to the server
    On Error GoTo ERR_CONNECTION:
    conn.ConnectionString = GET_CONNECTION_STRING ' trap additional error if you want
    conn.Open

    'Preparing SQL Execution
    Dim SQL_GET As String
    SQL_GET = "SELECT * FROM tbl_employee" ' extracts all data

    cmd.Name = "EMPSearch"
    cmd.ActiveConnection = conn
    cmd.CommandText = SQL_GET

    'Execute SQL
    Set rs = cmd.Execute

    On Error GoTo ERR_READ_SQL
    If Not rs.EOF Then
        With Sheets(1).Cells ' Enter your sheet name and range here
            .ClearContents
            .CopyFromRecordset rs
        End With
    Else
        Sheets(1).Range("A1").value = "No records found :("

    End If

EXIT_SUB:
    On Error Resume Next
    Set conn = Nothing
    Set cmd = Nothing
    Set rs = Nothing
    Exit Sub

ERR_CONNECTION:
    MsgBox "Sorry unable to connect to the server.." & vbNewLine & "Connection string: " & GET_CONNECTION_STRING & vbNewLine & "System Msg: " & Err.Description
    GoTo EXIT_SUB

ERR_READ_SQL:
    MsgBox "Sorry unable read/wite results on the sheet.." & vbNewLine & "System Msg: " & Err.Description
    GoTo EXIT_SUB
End Sub

If you have ODBC drivers installed, all the server details provided, SQL statement adjusted. just execute the sub_routine {Retrieve_EMP_Details} and you should be able to see the results in sheet(1)

如果您安装了 ODBC 驱动程序，则提供所有服务器详细信息，调整 SQL 语句。只需执行 sub_routine {Retrieve_EMP_Details}，您应该能够在 sheet(1) 中看到结果

Hope this helps and enjoy :)

希望这有助于和享受:)

Krish KM

克里什公里