ExcelでSQLを使う-017: ソース公開-01 DBLookup関数（Excel←→Access）

デイジー号が出産。三度目も5頭の仔犬でした。

なお、今回でママ犬は卒業します。

◇◇◇◇◇

１、Accessを参照するDBLookup関数

　DBLookup関数の原型は1996年に書きました。いわゆる Access のDLookup関数の代替関数です。DLookup関数には、複雑なSQL文を書けないという制約があります。また、一目でSQL文がイメージできないという難点もあります。それを打破する目的で書いたものです。もちろん、そのままでは Excelから同関数を利用してAccessデータベースを参照することはできません。それを可能にしたのが２番目のDBLookup関数です。

【Access ライブラリ関数】

Public Function DBLookup(ByVal strQuerySQL As String) As Variant
On Error GoTo Err_DBLookup
　　Dim DataValue
　　Dim rst As ADODB.Recordset

　　Set rst = New ADODB.Recordset
　　With rst
　　　　.Open strQuerySQL, _
　　　　　　　CurrentProject.Connection, _
　　　　　　　adOpenStatic, _
　　　　　　　adLockReadOnly
　　　　If Not .BOF Then
　　　　　　.MoveFirst
　　　　　　DataValue = .Fields(0)
　　　　End If
　　End With
Exit_DBLookup:
　　rst.Close
　　Set rst = Nothing
　　DBLookup = Nz(DataValue, ReturnValue)
　　Exit Function
Err_DBLookup:
　　MsgBox "SELECT 文の実行時にエラーが発生しました。(DBLookup)" & Chr$(13) & Chr$(13) & _
　　　　　 "・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　 "・SQL Text=" & strQuerySQL, _
　　　　　 vbExclamation, " 関数ｴﾗｰﾒｯｾｰｼﾞ"
　　Resume Exit_DBLookup
End Function

【Excel ライブラリ関数】

Public isEcho As Boolean

Public Function DBLookup(ByVal strSQL As String, _
　　　　　　　　　　　 ByVal strDB As String, _
　　　　　　　　　　　 Optional ByVal intSearch As Integer = 1, _
　　　　　　　　　　　 Optional returnValue As Variant = "") As Variant
On Error GoTo err_DBLookup:
　　Dim isFound As Boolean
　　Dim R　　　 As Integer
　　Dim N　　　 As Integer
　　Dim M　　　As Integer
　　Dim varData As Variant
　　Dim cnn　　 As Object
　　Dim rst　　 As Object　

　　' ---------------
　　'　Set

　　' ---------------

Set cnn = CreateObject("ADODB.Connection")

　　Set rst = CreateObject("ADODB.Recordset")
　　' -------------------------------------
　　' データベース　オープン
　　' -------------------------------------
　　cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDB & ";"
　　' ----------------------------------------
　　'　レコードセット　オープン
　　' ----------------------------------------
　　With rst
　　　　.Open strSQL, cnn, adOpenKeyset, adLockReadOnly
　　　　N = CInt(.RecordCount)
　　　　If intSearch < 0 Then
　　　　　　intSearch = N + intSearch + 1
　　　　End If
　　　　If Not .BOF Then
　　　　　　intSearch = intSearch - 1
　　　　　　.MoveFirst
　　　　　　M = N - 1
　　　　　　For R = 0 To M
　　　　　　　　If intSearch = R Then

　　　　　　　　　　varData = .Fields(0)

isFound = True

　　　　　　　　　　Exit For

　　　　　　　　End If
　　　　　　　　.MoveNext
　　　　　　Next R
　　　　End If
　　End With
Exit_DBLookup:
On Error Resume Next
　　rst.Close
　　cnn.Close
　　Set rst = Nothing
　　Set cnn = Nothing
　　DBLookup = IIf(isFound, varData, returnValue)
　　Exit Function
err_DBLookup:
　　If isEcho Then
　　　　MsgBox Err.Description
　　End If
　　Resume Exit_DBLookup
End Function

　DBLookup関数のエラーの表示・非表示を制御するのに広域な記号定数 isEcho を利用しています。

Sub SQLツールのエラー制御()
　　isEcho = Not isEcho
　　If isEcho Then
　　　　Message "SQLツールのエラーを常に表示します。"
　　Else
　　　　Message "SQLツールのエラーの表示を停止しました。"　　End If
End Sub

DBLookup関数の使用例_1

　DBLookup関数の使い方は簡単です。例えば、Access のDB1.mdb の[蔵書リスト]を参照するには、次のように書きます。