【ADO】mdbのレコードの条件検索

質問

日付+特定のレコードの値が優のレコードをExcelのセルに表示するマクロを組んでいます。

Option Explicit

Const cnsADO_CONNECT1 = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="

Dim dbCon As New ADODB.Connection
Dim dbRes As New ADODB.Recordset
Dim dbCols As ADODB.Fields
Dim strStartData As String, strEndData As String
Dim strsql As String
Dim Gyo As Long

Public Sub testテスト()

'テスト用
strStartData = 20120401
strEndData = 20130331

'接続mdb名
FileName = \\～～テスト.mdb

dbCon.Open cnsADO_CONNECT1 & FileName

strsql = "SELECT * FROM テーブル名 WHERE 日付 BETWEEN '" & strStartData & "' AND '" & strEndData & "' ORDER BY 日付"
　 dbRes.Open strsql, dbCon, adOpenKeyset, adLockReadOnly

strsql = Replace(strsql, "strEndData", strEndData)
strsql = Replace(strsql, "strStartData", strStartData)

dbRes.Filter = "座学判定　 = '優' or　WHERE 実技判定　 = '優' " 　

dbRes.Open strsql, dbCon, adOpenKeyset, adLockReadOnly　←ここでエラー

Gyo = 1
Rows("2:65536").ClearContents
dbRes.MoveFirst
Do Until dbRes.EOF
' 行の変数を加算し必要項目を選択してセルにセット
Gyo = Gyo + 1
Set dbCols = dbRes.Fields
'DT_P_点検Tblテーブルよりを抜き出す
Cells(Gyo, 1).Value = dbCols("ID").Value
Cells(Gyo, 2).Value = dbCols("日付").Value
Cells(Gyo, 3).Value = dbCols("座学判定").Value
Cells(Gyo, 4).Value = dbCols("実技判定").Value

' 次のレコードに移る
dbRes.MoveNext
Loop

' レコードセット、データベースを閉じる
dbRes.Close
Set dbRes = Nothing
dbCon.Close
Set dbCon = Nothing

End Sub

dbRes.Open strsql, dbCon, adOpenKeyset, adLockReadOnly　の部分でエラーになってしまいます。

「CommandオブジェクトのCommandTextが設定されていません」と表示されます。
dbRes.Filter = "座学判定　 = '優' or　WHERE 実技判定　 = '優' " 　
ここの部分が無ければ、指定の期間のデータを抽出してくれています。
指定期間　+　特定の部分がTrueの場合の抜き出しをしたいのですが、どこかで指定が不足しているのでしょうか？

回答No.3

30246kiku

エラーになるのは、２回目の dbRes.Open 時でしょうか？
dbRes.Filter に指定した文字列内に WHERE があるから？では
（全角スペースもそうだと思いますけど）

dbRes.Filter のエラーでなければ、メッセージ内容からすると、
CommandオブジェクトのCommandText は SQL 部分だったと思うので、
dbRes.Open の引数ではなく、事前に dbRes.Source で設定すれば？？

> dbRes.Open strsql, dbCon, adOpenKeyset, adLockReadOnly
↓
dbRes.Source = strsql
dbRes.Open , dbCon, adOpenKeyset, adLockReadOnly

うまくいくんでしょうか？（未検証：嘘の可能性大）

エラーを追求するのは必要だと思いますが、
そもそも　dbRes.Open は、２回必要でしょうか。
特に２回目前の
> strsql = Replace(strsql, "strEndData", strEndData)
では、strsql　内に文字列 "strEndData" は存在しないので無駄と思います。
（１回目の時に、既に strEndData は展開されているので）

また、Do Until 部分は
SELECT * FROM ・・・・　ではなく、
SELECT ID, 日付, 座学判定, 実技判定 FROM ・・・・　で得ておけば、
Cells(2, 1).CopyFromRecordset dbRes と記述できると思います。

動作未検証ですが、以下ではどうでしょう。（不都合あれば修正してください）
基本となる SQL を Const 宣言しておき、置換える部分を {%1} {%2} の文字列にして、
その {%1} {%2} を展開した後で　dbRes.Open します。

Option Explicit

Const cnsADO_CONNECT1 = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
Const cnsSQL = "SELECT ID, 日付, 座学判定, 実技判定 FROM テーブル名 " _
　　　　　　& "WHERE (日付 BETWEEN '{%1}' AND '{%2}') " _
　　　　　　& "AND (座学判定 = '優' OR 実技判定 = '優') " _
　　　　　　& "ORDER BY 日付;"

Public Sub testテスト2()
　　Dim dbCon As New ADODB.Connection
　　Dim dbRes As New ADODB.Recordset
　　Dim strsql As String

　　dbCon.Open cnsADO_CONNECT1 & "\\～～テスト.mdb"

　　strsql = cnsSQL
　　strsql = Replace(strsql, "{%1}", "20120401")
　　strsql = Replace(strsql, "{%2}", "20130331")
　　dbRes.Open strsql, dbCon, adOpenForwardOnly, adLockReadOnly

　　If (Not dbRes.EOF) Then
　　　　Rows("2:65536").ClearContents
　　　　Cells(2, 1).CopyFromRecordset dbRes
　　End If

　　dbRes.Close
　　dbCon.Close
End Sub

回答No.2

hatena1989

dbRes.Filter = "座学判定　 = '優' or　WHERE 実技判定　 = '優' "

このコードは実際のコードをそのままコピペしたものですか。
フィールド名の後に全角空白がありますが、実際のフィーにド名にも全角空白はありますか。
ないのなら、全角空白を削除してください。

dbRes.Filter = "座学判定 = '優' or　WHERE 実技判定 = '優'"

なお、Filterを使わずに、SQLに抽出条件を含めてしまうほうシンプルになるし、処理が高速です。

strsql = "SELECT * FROM テーブル名 WHERE 日付 BETWEEN '" & _
strStartData & "' AND '" & strEndData & "' & _
" AND (座学判定 = '優' or　WHERE 実技判定 = '優')" & _
" ORDER BY 日付"
dbRes.Open strsql, dbCon, adOpenKeyset, adLockReadOnly

回答No.1

Nouble

お力が凄そうで私などお力になれるか…
ただ、お伺いする位なら出来るかと…

考えを表に表し説明すると、
そこに新たな視点か生まれ、
整理できると聞きます。

貴方はおおよそ指導的立場でもこなせそうな方、
整理さえできれば
ご自力で解決もあろうかと思います。

是非、何をどうされているか、このものに
ご解説頂けないでしょうか？

宜しくお願いします。