パラメータ付きの選択クエリをADODBで実行して、結果を引数に格納する形でRecordsetを返す。
コピーしてそのまま使えるサンプル。
サンプルコード
参照設定
「Microsoft Active Data Object x.x Library」にチェックを付ける。
コード
Public Function FncGetRstFromParameterQuery(ByVal vsQueryName As String, _
ByVal vsParamKeys As String, _
ByVal vsParamValues As String, _
ByRef robjRS As ADODB.Recordset, _
Optional ByRef rsMsg As String = "") As Boolean
On Error Goto Err_Sec
Dim bRet As Boolean
Dim sMsg As String
Dim sArrParamKey() As String
Dim sArrParamValue() As String
Dim objCmd As ADODB.Command
Dim i As Long
bRet = False
sMsg = ""
'--- パラメータ名と値をカンマで分割して配列に格納する ---
If Len(vsParamKeys) > 0 Then
sArrParamKey = Split(vsParamKeys, Chr(44))
End If
If Len(vsParamValues) > 0 Then
sArrParamValue = Split(vsParamValues, Chr(44))
End If
'--- パラメータ名と値の数が一致しない場合エラー ---
If Len(vsParamKeys) > 0 or Len(vsParamValues) > 0 Then
If Not IsArray(sArrParamKey) Or Not IsArray(sArrParamValue) Then
sMsg = "パラメータ名と値の数が一致しません。"
GoTo Exit_Sec
Else
If Not (UBound(sArrParamKey) = UBound(sArrParamValue)) Then
sMsg = "パラメータ名と値の数が一致しません。"
GoTo Exit_Sec
End If
End If
End If
Set objCmd = New ADODB.Command
Set robjRS = New ADODB.Recordset
With objCmd
.ActiveConnection = CurrentProject.Connection
.CommandType = adCmdStoredProc
.CommandText = vsQueryName
.CommandTimeout = 120
If Len(vsParamKeys) > 0 Then
.Parameters.Refresh
For i = 0 To UBound(sArrParamKey)
.Parameters.Append .CreateParameter( _
sArrParamKey(i), adVarChar, adParamInput, Len(sArrParamValue(i)), sArrParamValue(i))
Next i
End If
End With
With robjRS
.CursorLocation = adUseClient
.Open objCmd, , adOpenStatic, adLockReadOnly
End With
bRet = True
Exit_Sec:
On Error Resume Next
Set objCmd = Nothing
rsMsg = sMsg
FncGetRstFromParameterQuery = bRet
Exit Function
Err_Sec:
sMsg = Err.Number & ":" Err.Description
Resume Exit_Sec
End Function
特徴は、Recordsetの「CursorLocation」に「adUseClient」を設定している点。
呼び出し元で、RecordCountを使用してレコード数を取得したい場合にこの設定が必要となる。
RecordsetのOpen時にCursorLocationの指定を省略すると、「adUseServer」がデフォルトのため、RecordCountを参照すると-1になってしまう。
Accessの選択クエリの場合に限り、ADODB.Commandオブジェクトの CommandType に adCmdTableを設定することができる。
この場合、Parameters.Append や CreateParameter を実行しようとすると実行時エラーとなるため、以下の記述になる。
With objCmd
.ActiveConnection = CurrentProject.Connection
.CommandType = adCmdTable
.CommandText = vsQueryName
.CommandTimeout = 120
If Len(vsParamKeys) > 0 Then
.Parameters.Refresh
For i = 0 To UBound(sArrParamKey)
.Parameters(sArrParamKey(i)) = sArrParamValue(i)
Next i
End If
End With
呼び出し例
呼び出す側で、ADODB.Recordset型の変数を用意して、引数に渡してやる。
コード
Dim sMsg As String
Dim objRs As ADODB.Recordset
If Not FncGetRstFromParameterQuery("Q_クエリ", "都道府県名", "東京都", objRS, sMsg) Then
If Len(sMsg) <= 0 Then sMsg = "レコードの取得でエラーが発生しました。"
Goto Exit_Sec
End If
If objRS.EOF Then
sMsg = "対象レコード0件です。"
Goto Exit_Sec
End If
With objRS
Debug.Print "レコード件数:", .RecordCount
'--- 取得後は各自ご自由に... ---
Do Until .EOF
Debug.Print !会員番号, !氏名, !メールアドレス
Loop
End With
Exit_Sec:
Set objRS = Nothing
この例のようにレコードセットを順次参照するならRecordCountが正しく取れてなくても特に困らないが、配列に格納したいときはあらかじめ件数がわかっていた方が色々とラク。