[Excel VBA]Access連携で合致する日付のデータを取得したい

Question

前提・実現したいこと

VBA初心者です。
accessにため込んでいるデータの検索フォームをexcel vbaで作成しようとしております。
excelの入力フォームに入力した日付で、accessからデータを取得しようとすると、フリーズしてしまいます。
該当するSQL文を削除して実行すると正常に機能するので、SQL文のWHERE以降に問題があるのではないかと思っておりますが、解決方法をご教授いただけないでしょうか。
（フォームに入力した日付と、access内の日付型データで、型が異なっているせいではないかと推測しています）

該当のソースコード

※該当箇所のみ抜粋。
===================================検索機能====================================
Private Sub btn検索実行_Click()

On Error GoTo HandleErr

Application.ScreenUpdating = False
Me.lst検索結果.Clear

Dim Start As Variant, Finish As Variant
Start = Time

'＝＝＝＝＝＝＝＝＝＝＝＝＝＝検索条件を取得する＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Dim src実施日from As Date

src実施日from = Me.txt実施日from.Value '実施日fromの入力内容を取得

'＝＝＝＝＝＝＝＝＝＝＝＝アクセスに接続する＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Dim strFileName As String
strFileName = "活動DB.accdb"

Set adoCn = CreateObject("ADODB.Connection") 'ADOコネクションオブジェクトを作成
adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\" & strFileName & ";" 'Accessファイルに接続

'===============検索する＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Set adoRs = CreateObject("ADODB.Recordset") 'ADOレコードセットオブジェクトを作成
 
Dim strSQL As String
Dim cnt As Long

adoCn.CommandTimeout = 0

strSQL = p_setSQL(src実施日from) '検索するSQL
 
adoRs.Open strSQL, adoCn, adOpenKeyset, adLockReadOnly 'SQLを実行して対象をRecordSetへ
adoRs.MoveFirst
 
With Me.lst検索結果  '該当したレコードをリストボックスに表示する
            .ColumnCount = 9 '列数 9
            .ColumnWidths = "40;70;70;90;100;100;150;200;60" '列幅を設定
            cnt = 0
            Do While adoRs.EOF = False     '抽出したレコードが終了するまで繰り返す
            
                .AddItem
                    Me.lst検索結果.List(cnt, 0) = adoRs.Fields("AA").Value
                    Me.lst検索結果.List(cnt, 1) = adoRs.Fields("BB").Value
                    Me.lst検索結果.List(cnt, 2) = adoRs.Fields("実施日1").Value
                    Me.lst検索結果.List(cnt, 3) = adoRs.Fields("CC").Value
                    Me.lst検索結果.List(cnt, 4) = adoRs.Fields("DD").Value
                    Me.lst検索結果.List(cnt, 5) = adoRs.Fields("EE").Value
                    Me.lst検索結果.List(cnt, 6) = adoRs.Fields("FF").Value
                    Me.lst検索結果.List(cnt, 7) = adoRs.Fields("GG").Value
                  
            adoRs.MoveNext
                cnt = cnt + 1
            Loop
End With

Finish = Time
MsgBox ("取得が完了しました。" & vbLf & "実行時間は" & Format(Finish - Start, "nn分ss秒") & "でした。" & vbCrLf & "件数結果:" & (Me.lst検索結果.ListCount))

Application.ScreenUpdating = True

adoRs.Close 'レコードセットのクローズ
adoCn.Close 'コネクションのクローズ
 
Set adoRs = Nothing
Set adoCn = Nothing  'オブジェクトの破棄

HandleErr:
Resume Next

Exit Sub
End Sub
Private Function p_setSQL(ByVal src実施日from) As String

Dim strSQL As String
Dim strWhere As String

strSQL = "SELECT * FROM 活動表 "

strWhere = "WHERE "    
    If src実施日from <> "" Then
        If strWhere <> "WHERE " Then
            strWhere = strWhere & "AND 実施日1 >= src実施日from"
        Else
            strWhere = strWhere & " 実施日1 >= src実施日from"
        End If
    End If


    If strWhere <> "WHERE " Then
        strSQL = strSQL & strWhere
    End If
    
    p_setSQL = strSQL

 '=======================8桁の数字にスラッシュを挿入する=============================
Private Sub txt実施日from_change()
  Dim org As String
  Dim buf As String

  With Me.txt実施日from
  org = .Value
    If Len(org) = 8 Then
      buf = _
        Mid(org, 1, 4) & "/" & _
        Mid(org, 5, 2) & "/" & _
        Mid(org, 7, 2)
      If IsDate(buf) = True Then
        .Value = buf
      
      End If  ' IsDate
    End If  ' Len = 8
  End With  ' ActiveCell

End Sub

試したこと

・宣言する変数の型をAs stringに変更
・src実施日= CDate(Me.txt実施日from.Value)に変更
・sqlのWhere以降で、実施日1をformat関数利用でyyyymmddに変更
・テキストボックスに入力した数字をハイフンで区切る部分を抹消

※strWhereを下記の通り修正したら問題なく動きました。
If src実施日from <> "" Then
If strWhere <> "WHERE " Then
strWhere = strWhere & "AND 実施日1 Between #2017/04/01# And #2018/12/31#"
Else
strWhere = strWhere & "実施日1 Between #2017/04/01# And #2018/12/31#"
End If
End If

Answer 1

手元にAccessが無いので、検証できていませんが、
Where の SQL 文を作成しているFunction関数で、値の代入で、変数を直接入れているので、
SQL文で構文エラーになっていると推測します。
確か、日付なのに文字で指定しないと動かない記憶です。

    If src実施日from <> "" Then
        If strWhere <> "WHERE " Then
            strWhere = strWhere & "AND 実施日1 >= #" & Format(src実施日, "yyyy/mm/dd") & "# "
        Else
            strWhere = strWhere & " 実施日1 >= #" & Format(src実施日, "yyyy/mm/dd") & "# "
        End If
    End If

Comments

[3110111y]

kai_keitai様

返信遅くなりましてすみません。
kai_keitai様の修正案でやってみても無事動きました、ありがとうございます！
As Dateとして宣言していても、文字で指定しないと動かないのですね…SQLについてよくわかっていなかったことが判明したので、勉強したいと思います。

Sazi様の方が回答が早く、また動かした結果処理速度もなぜか若干早かったため、そちらをベストアンサーとさせていただきましたが、今後ともどうぞよろしくお願いいたします。

[kai_keitai]

何事も苦労した経験が糧となるのです。頑張って下さい。
尚、元データがSQL Server である場合、# ではなく、" でくくるのです。
SQL は、昔からあまり変わっていません。よって、一度覚えれば、普遍的に活用できるので、是非覚えてください。

Answer 2

strSQL = "SELECT * FROM 活動表 "
If src実施日from <> "" Then
  strSQL = strSQL & "WHERE 実施日1 >=#" & src実施日from & "#"
end if
p_setSQL = strSQL

複数の条件があるなら、以下の様なコードの方がシンプル

strSQL = "SELECT * FROM 活動表 "
strWhere = ""
If src実施日from <> "" Then
  strWhere = strWhere & "AND 実施日1 >=#" & src実施日from & "#"
end if
'～以下上記と同様な条件編集が続く～
If strWhere <> "" Then
  strSQL = strSQL & " where " & Mid(strWhere, 4) '先頭のAND を除く
End If
p_setSQL = strSQL

因みに、Access使ってるならAccess側からエクセル出力する方が楽じゃないんでしょうか？

ついでに、

buf = _
        Mid(org, 1, 4) & "/" & _
        Mid(org, 5, 2) & "/" & _
        Mid(org, 7, 2)

上記は以下で済みます。

buf = Format(org, "0000/00/00")

Comments

[3110111y]

返信遅くなりましてすみません。
sazi様にご教示いただいた方法で無事稼働しました！
自分であれこれやっていた時に#を付けてみたこともあったのですが、その際は&を付けず構文エラーになってしまい、上手く行っていなかったようです。SQLの書き方の基本をしっかりできていなかったため、躓いていたことが分かりましたので、他の回答者様からいただいたリンク等で勉強したいと思います。
また、色々とシンプルなコードもご教示いただきありがとうございます。こういうところでFormat関数を使えばいいということが分かり、大変勉強になりました。

迅速にご回答いただけたおかげで、大変助かりました。

Answer 3

回答は既に他の方から出ていますので、根本的なことについて。

質問者さんは、たぶん、VBAコード内でのSQLコードの扱いについて理解できてないのだと思います。
下記で解説していますので、一度、目を通しておくことをお勧めします。

Access上のコード内で引用符(")と単引用符(')の使い分けについて - hatena chips

追記

上のリンク先は文字列型の場合の書き方にしか触れてませんが、
日付/時刻型の場合は、引用符ではなく、# で囲む必要があります。
そのへんは、他の方の回答を参考にしてください。

おまけ

取得したレコードセットをリストボックスにセットするのは、GetRowsで配列として取得して、それをListプロパティに代入するとシンプルです。

With Me.lst検索結果  '該当したレコードをリストボックスに表示する
    .ColumnCount = 9 '列数 9
    .ColumnWidths = "40;70;70;90;100;100;150;200;60" '列幅を設定
    .List = WorksheetFunction.Transpose(adoRs.GetRows)
End With

（縦横が逆なので、Transposeする必要があります。）

---

ベストアンサーは他に方につけください。あくまで、補足的なことですので。

Comments

[sazi]

リンク先は質問のコードに関係しています？
どちらかというと型に対する扱いだと思いますけど。

[hatena19]

直接関係あるかと言われればないかも知れませんが、
strWhere = strWhere & "AND 実施日1 >= src実施日from"
というように文字列内に変数を埋め込んでしまっている間違いについて、リンク先ではふれています。
このような間違いを犯すのは「VBAコード内でのSQLコードの扱い」についての理解の問題かと思います。
リンク先では文字列型の扱いだけしか触れていなくて、ここでは日付/時刻型なので、引用符ではなく # で囲む必要があるということは補足しておいた方がいいですが、他の回答に既にあるので、あわせて読めば理解が深まるかと思って回答しました。

[sazi]

そういう意図でしたか。了解しました。

[3110111y]

hatena 19様

返信遅くなりましてすみません。
リンク先をご紹介いただき、ありがとうございます。
お気づきの通り、引用符と単一府について違いを理解できておりませんでした。本やネットで紹介されているものをコピペしながら今までやってきていたので、これを機にしっかりと理解したいと思います。

ご配慮いただきありがとうございました！