きなこSHOW

自作プログラム置き場です。

Access ADO使用 パラメータ付き選択クエリの結果セットをRecordsetで返すサンプル

パラメータ付きの選択クエリを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が正しく取れてなくても特に困らないが、配列に格納したいときはあらかじめ件数がわかっていた方が色々とラク。