多分これはあなた/他の人を助けるかもしれません:
次の参照をプロジェクトに追加します: Microsoft ActiveX Data object 2 (またはそれ以降のバージョン)
このコードをモジュールに投げて保存します: このモジュールでサーバーの詳細を編集します。
'---------------------------------------------------------------------------------------
' 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
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
ODBC ドライバーがインストールされている場合は、すべてのサーバーの詳細が提供され、SQL ステートメントが調整されます。sub_routine {Retrieve_EMP_Details} を実行するだけで、sheet(1) で結果を確認できるはずです
これがお役に立てば幸いです:)
クリッシュ KM