ODBC
　
　 　 Option Explicit
Private mwspOra As Workspace
Private mdbsOra As Database
Private mrdynOra As Recordset
'Private Declare Function SQLDataSources Lib "ODBC32.DLL" (ByVal henv&, ByVal fDirection%, ByVal szDSN$, ByVal cbDSNMax%, pcbDSN%, ByVal szDescription$, ByVal cbDescriptionMax%, pcbDescription%) As Integer
'Private Declare Function SQLAllocEnv% Lib "ODBC32.DLL" (env&)
Sub vba_odbc()
Dim dsn As String
Dim uid As String
Dim pwd As String
Dim strConn As String
Dim strsql As String
Dim iintCol As Integer
Dim strItem As Long
Dim i As Long
On Error GoTo errClick:
Sheets("Sheet1").Select
dsn = Evaluate("Sheet1!A2").Value
uid = Evaluate("Sheet1!C2").Value
pwd = Evaluate("Sheet1!D2").Value
strConn = "ODBC;" & "UID=" & uid & ";" & "PWD=" & pwd & ";" & "DSN=" & dsn
Set mwspOra = CreateWorkspace("ODBC", "admin", "", dbUseODBC)
Set mdbsOra = mwspOra.OpenDatabase(vbNullString, False, dbDriverNoPrompt, strConn)
'MsgBox "接続成功", vbOKOnly + vbInformation
Sheets("Sheet2").Select
For i = 1 To 3
strsql = "select count(*) from テーブル where a ='" & Cells(i, 1) & "'"
Set mrdynOra = mdbsOra.OpenRecordset(strsql, dbOpenDynaset, dbReadOnly, dbReadOnly)
'MsgBox "レコードセット取得成功", vbOKOnly + vbInformation
For iintCol = 0 To mrdynOra.Fields.Count - 1
strItem = mrdynOra.Fields(iintCol).Value
If strItem = 0 Then
Cells(i, 2) = "*"
End If
Next
mrdynOra.Close
Set mrdynOra = Nothing
'MsgBox "レコードセット破棄成功", vbOKOnly + vbInformation
Next i
exitClick:
mdbsOra.Close
Set mdbsOra = Nothing
Set mwspOra = Nothing
'MsgBox "切断成功", vbOKOnly + vbInformation
MsgBox "お・わ・り", vbOKOnly + vbInformation
On Error Resume Next
Exit Sub
errClick:
MsgBox "msg=" & Error$, vbOKOnly + vbExclamation
Resume exitClick:
End Sub