質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.59%

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

解決済

回答 3

投稿

  • 評価
  • クリップ 0
  • VIEW 1,544

3110111y

score 13

前提・実現したいこと

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 

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 3

checkベストアンサー

+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")

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/04/01 14:12

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

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

    キャンセル

+2

手元に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

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/04/01 14:22

    kai_keitai様

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

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

    キャンセル

  • 2019/04/01 21:35

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

    キャンセル

+1

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

質問者さんは、たぶん、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する必要があります。)


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

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/03/29 17:03

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

    キャンセル

  • 2019/03/29 17:13

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

    キャンセル

  • 2019/03/29 17:25

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

    キャンセル

  • 2019/04/01 14:25

    hatena 19様

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

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

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.59%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る