【Access VBA】過去時点での在庫検索

質問

現在、蔵書管理表をAccessで作成しています。

書籍は購入後、古くなると廃棄するようになっています。

現時点での蔵書だけではなく、過去日付を検索フォームに入力すると、
その過去時点の蔵書もAccessで表示できるようにしたいと思っています。

データが入力されているフォーム「蔵書一覧」のフィールドは
「(1)書籍名　(2)購入日　(3)廃棄日」の３つがあり、廃棄が終了すると
「(3)廃棄日」フィールドに廃棄した日付を入力します。
未廃棄のものは、「(3)廃棄日」フィールドには日付を入力せず空欄のままです。

そこで、ある過去時点での蔵書を抽出するために、ＶＢＡを以下のように記述したところ、
「(3)廃棄日」が入力されているレコードは抽出できるのですが、
未廃棄のレコード（「(3)廃棄日」に日付が入っていないレコード）がうまく抽出できません。

Private Sub 検索ボタン_Click()

Dim filter1 As String
DoCmd.OpenForm "蔵書一覧", acNormal

filter1 = "廃棄日 >= # " & Me!検索日付 & "#"
Forms!蔵書一覧!.Filter = filter1
Forms!蔵書一覧!.FilterOn = True
End Sub

未廃棄の蔵書も抽出するにはどのようにコードを記述すればよいでしょうか。
どなたかお教えいただけませんでしょうか、よろしくお願いいたします。

回答No.7

山田 太郎（@f_a_007）

【補足】IsNull()を利用するかしないか？

これは、好みと趣味の問題です。

Len([fieldname] & "")

で長さ=0 なら”偽"、長さ＞0なら”真”。で、空値かどうかを判定できます。が、Access には IsNull 関数が用意されています。添付図のように、どちらを利用しても同じ結果が得られます。まあ、Empty値のチェックではISNull()が通用しないので、私は、Len(XXX & "")で一貫していますが、全く、これは好みと趣味の問題です。

お礼

f_a_007さん、ご丁寧に回答いただき誠にありがとうございました。
無事抽出することができました。
大変勉強になりました。

回答No.6

山田 太郎（@f_a_007）

他の方の回答を見て、テストデータの不足に気が付きました。で、４件で再テスト。

【全ての蔵書】

? DBSelect("SELECT * FROM 蔵書一覧 ORDER BY 購入日, ID",,Chr(13) )

1;軽井沢のボーイ;牧野出版;海老原靖芳;2001/01/01;2010/12/31
2;ワンワン物語;ハスキー社;原一郎;2002/01/01;
3;盲導犬クールの一生;文芸春秋;石黒健吾;2002/01/01;2002/12/31
4;Siberian Husky WON WON;白水社;新倉万蔵;2003/01/01;

【指定日以前に購入して廃棄していない蔵書】

? DBSelect("SELECT * FROM 蔵書一覧 WHERE 購入日<=#2002/12/30# AND Not Len(廃棄日 & """") ORDER BY 購入日, ID",,Chr(13))

2;ワンワン物語;ハスキー社;原一郎;2002/01/01;

【指定日以前に購入して、指定日までに廃棄していない蔵書】

? DBSelect("SELECT * FROM 蔵書一覧 WHERE 購入日<=#2002/12/30# AND (廃棄日>#2002/12/30# Or Not Len(廃棄日 & """")) ORDER BY 購入日, ID",,Chr(13))

1;軽井沢のボーイ;牧野出版;海老原靖芳;2001/01/01;2010/12/31
2;ワンワン物語;ハスキー社;原一郎;2002/01/01;
3;盲導犬クールの一生;文芸春秋;石黒健吾;2002/01/01;2002/12/31

が正解！？あっているかどうかは、質問者もよく確認されてください。赤で良いと思うのですが・・・

回答No.5

piroin654

失礼しました。

＞ある過去時点での蔵書を抽出する

ということなので、購入日も考慮して、

filter1 = "([購入日] <= # " & Me!検索日付 & "#) And ([廃棄日] >= # " & Me!検索日付 & "# Or [廃棄日] Is Null)"

とします。

お礼

piroin654さんありがとうございました。
無事目的通り抽出することができました。
大変勉強になりました。

回答No.4

piroin654

＞書籍は購入後、古くなると廃棄するようになっています。

＞現時点での蔵書だけではなく、過去日付を検索フォームに入力すると、
＞その過去時点の蔵書もAccessで表示できるようにしたいと思っています。

という条件で、
＞書籍は購入後、古くなると廃棄するようになっています。
が必ず実行されているということであれば、

複数条件でのフィルタのかけ方で、質問の場合は、

filter1 = "[廃棄日] >= # " & Me!検索日付 & "# Or [廃棄日] Is Null"

とします。

回答No.3

山田 太郎（@f_a_007）

【おまけ】いちいち、SQL文やFilterをフォームを開いて確認は手間。

その手間を省くには、[イミディエイトウインドウ]でチョコチョコとテストされたらいいです。その為には、添付図のようなDBSelect()関数を標準モジュールに追加するだけ。

Public Function DBSelect(ByVal strQuerySQL As String, _
　　　　　　　　　　　　 Optional colDelimita As String = ";", _
　　　　　　　　　　　　 Optional rowDelimita As String = ";") As String
On Error GoTo Err_DBSelect
　　Dim R　　　　　 As Integer ' 行インデックス
　　Dim N　　　　　 As Integer ' 行総数 - 1
　　Dim rst　　　　 As ADODB.Recordset
　　Dim fld　　　　 As ADODB.Field
　　Dim strList　　 As String　' 全てのデータを区切子で連結して格納

　　Set cnn = CurrentProject.Connection
　　Set rst = New ADODB.Recordset
　　With rst
　　　　.Open strQuerySQL, _
　　　　　　　CurrentProject.Connection, _
　　　　　　　adOpenStatic, _
　　　　　　　adLockReadOnly
　　　　If Not .BOF Then
　　　　　　N = .RecordCount - 1
　　　　　　.MoveFirst
　　　　　　For R = 0 To N
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　With fld
　　　　　　　　　　　　strList = strList & .Value & colDelimita
　　　　　　　　　　End With
　　　　　　　　Next fld
　　　　　　　　strList = Mid(strList, 1, Len(strList) - 1) & rowDelimita
　　　　　　　　.MoveNext
　　　　　　Next R
　　　　Else
　　　　　　strList = ""
　　　　End If
　　End With
Exit_DBSelect:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DBSelect = IIf(Len(strList) > 0, Replace(strList & "[END]", rowDelimita & "[END]", ""), "")
　　Exit Function
Err_DBSelect:
　　MsgBox "SELECT 文の実行時にエラーが発生しました。(DBSelect)" & Chr(13) & Chr(13) & _
　　　　　　"・Err.Description=" & Err.Description & Chr(13) & _
　　　　　　"・SQL Text=" & strQuerySQL, _
　　　　　　vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_DBSelect
End Function

ADODBを参照するように設定する必要があるかもですが、そこら辺の要領は検索されて下さい。なお、３番目の引数に Chr(13)　をしてしないと、レコード単位で改行しません。

回答No.2

山田 太郎（@f_a_007）

クエリもオープン文も、もちろん３番目のSQL文を書きます。例示は、ちょいとコピペミスしております。が、意味は通じると思います。

お礼

f_a_007 さんありがとうございます。
ご回答いただいた内容で試してみます。

回答No.1

山田 太郎（@f_a_007）

１、filtr 機能を使うケースではないと思います。
２、テーブル構造を明示して質問されたが正答を得られるかと思います。

【全ての蔵書を抽出するSQL文】

? DBSelect("SELECT * FROM 蔵書一覧",,chr(13))
1;軽井沢のボーイ;牧野出版;海老原靖芳;2001/01/01;2010/12/31
2;盲導犬クールの一生;文芸春秋;石黒健吾;2002/01/01;
3;Siberian Husky WON WON;白水社;新倉万蔵;2003/01/01;

【2002/12/31 以前の蔵書を抽出するSQL文】

? DBSelect("SELECT * FROM 蔵書一覧 WHERE 購入日<=#2002/12/31#",,chr(13))
1;軽井沢のボーイ;牧野出版;海老原靖芳;2001/01/01;2010/12/31
2;盲導犬クールの一生;文芸春秋;石黒健吾;2002/01/01;

【2002/12/31時点の蔵書を抽出するSQL文】

? DBSelect("SELECT * FROM 蔵書一覧 WHERE 購入日=<=#2002/12/31# AND NOT LEN(廃棄日 & """")",,chr(13))
2;盲導犬クールの一生;文芸春秋;石黒健吾;2002/01/01;

質問者の書いたSQL文は、上の３つのどれにも該当しません。添付図のように2010/12/31に廃棄した「軽井沢のボーイ」がヒットするだけです。

ということで、書くべき WHERE節（＝フィルタの指定文）はお分かりいただけたとおもいます。が、質問者は、

１、フォームをオープンする。
２、フィルタをオンにする。

という手順で[蔵書一覧]を絞り込んでいます。と、いうことは、フォームは、一旦、全てのレコードを読み込んでいるってことです。これは、無駄。

SELECT *
FROM 蔵書一覧
WHERE 購入日<=[検索する日付を入力してください];

というSQL文を用意する。あるいは、[検索日]と[検索コマンドボタン]のあるフォームを用意して

Private Sub コマンド検索_Click()
　　Dim stLinkCriteria As String

　　stLinkCriteria = "[購入日]<=" & "#" & Me![検索日] & "#"
　　DoCmd.OpenForm stDocName, , , stLinkCriteria
End Sub

とやるのが一般的ですね。