【Access】非連結テキストボックス内の値の有無を判別してレコードを抽出させる

というのが今回の目的です。

非連結テキストボックス（コンボボックス）値の有無

そんなの簡単だよって思っていましたが、自分が思うような判定ができません。

値が入っているなら、

IsNull(pu_date_start)  or  pu_date_start=""

で値が入ってない時を判別できるんじゃないの？

If Nz(Me.pu_date_start, "") <> "" And Nz(Me.pu_date_end, "") <> "" Then
    hantei = hantei + 1

ElseIf Nz(Me.pu_date_start, "") <> "" Then
    If Nz(Me.pu_date_end, "") = "" Then
        MsgBox "集荷日終了が入力されていません"
    Exit Sub
    End If
    
ElseIf Nz(Me.pu_date_end, "") <> "" Then
    If Nz(Me.pu_date_start, "") = "" Then
        MsgBox "集荷日開始が入力されていません"
    Exit Sub
    End If
End If
   

If Nz(Me.delivery_date_start, "") <> "" And Nz(Me.delivery_date_end, "") <> "" Then
    hantei = hantei + 10
    
ElseIf Nz(Me.delivery_date_start, "") <> "" Then
    If Nz(Me.delivery_date_end, "") = "" Then
        MsgBox "配達日終了が入力されていません"
    Exit Sub
    End If
    
ElseIf Nz(Me.delivery_date_end, "") <> "" Then
    If Nz(Me.delivery_date_start, "") = "" Then
        MsgBox "配達日開始が入力されていません"
    Exit Sub
    End If
End If

いろいろと試した結果、

Nz(Me.pu_date_start, "") <> ""　　　⇒　値が有り

Nz(Me.pu_date_start, "") ＝ ""　　　⇒　値が無い

という方法がちゃんと判別することができました。

上のコードは、日付範囲を設定するフォームになりますが、範囲開始か、範囲終了のどちらかに値がある場合は、値が無い方をメッセージボックスを出現させて警告をするものです。

値のある非連結テキストボックスだけ抽出

複数の非連結テキストボックスや、非連結のコンボボックスなどで、大量のデータから目的のデータを抽出してレコードソースにしたい時がある。

そこで、抽出ワード（値）があるものだけで抽出して、無い時はスルーするという事がやりたかったことです。

ただVBAコードを載せておくだけになってしまっていますが、テキストだったり、日付などが複数混ざっている状態の「’」「”」「＆」って本当に難しいので自分の備忘録として乗せておくことにしました。

【Access】フォームの非連結コンボボックスからＳＱＬで抽出する時の「’」「”」「＆」などの使い方

Public Sub tyushutsu_btn_Click()

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim hantei As Integer
Dim naiyou As String

' hanteiの数値により、抽出項目に値があるのかを判定している。
haitei = 0

    If Nz(Me.pu_date_start, "") <> "" And Nz(Me.pu_date_end, "") <> "" Then
        hantei = hantei + 1

    ElseIf Nz(Me.pu_date_start, "") <> "" Then
        If Nz(Me.pu_date_end, "") = "" Then
            MsgBox "集荷日終了が入力されていません"
        Exit Sub
        End If
        
    ElseIf Nz(Me.pu_date_end, "") <> "" Then
        If Nz(Me.pu_date_start, "") = "" Then
            MsgBox "集荷日開始が入力されていません"
        Exit Sub
        End If
    End If
    
    
    If Nz(Me.delivery_date_start, "") <> "" And Nz(Me.delivery_date_end, "") <> "" Then
        hantei = hantei + 10
        
    ElseIf Nz(Me.delivery_date_start, "") <> "" Then
        If Nz(Me.delivery_date_end, "") = "" Then
            MsgBox "配達日終了が入力されていません"
        Exit Sub
        End If
        
    ElseIf Nz(Me.delivery_date_end, "") <> "" Then
        If Nz(Me.delivery_date_start, "") = "" Then
            MsgBox "配達日開始が入力されていません"
        Exit Sub
        End If
    End If
    
    If Nz(Me.search_mado, "") <> "" Then    ' 出荷人
    hantei = hantei + 100
    End If

    If Nz(Me.trader_search, "") <> "" Then  ' 業者
    hantei = hantei + 1000
    End If
    
    If Nz(Me.delivery_mado, "") <> "" Then  ' 配達先
    hantei = hantei + 10000
    End If
    
 ' 長くなってしまった抽出項目を変数にしました。
    naiyou = "(trader1 ='" & Me!trader_search & "'or trader2 = '" & Me!trader_search & "'or trader3 = '" & Me!trader_search & "'or trader4 = '" & Me!trader_search & "'or trader5 = '" & Me!trader_search & "')"

On Error GoTo Err_Handler

    Set cn = CurrentProject.AccessConnection
    Set rs = New ADODB.Recordset

            With rs
            Set .ActiveConnection = cn
            
            If hantei = 100 Then    ' 出荷人
                        .Source = "SELECT * FROM orderdata_sorting WHERE shipper ='" & Me!search_mado & "'"
                        
            ElseIf hantei = 101 Then    ' 出荷人+集荷日
                        .Source = "SELECT * FROM orderdata_sorting WHERE shipper ='" & Me!search_mado & "' And pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#"
            
            ElseIf hantei = 111 Then    ' 出荷人+集荷日+配達日
                        .Source = "SELECT * FROM orderdata_sorting WHERE shipper ='" & Me!search_mado & "' And pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#" & "And delivery_date Between #" & Me!delivery_date_start & "# AND #" & Me!delivery_date_end & "#"
           
            ElseIf hantei = 10101 Then   ' 出荷人+配達先+集荷日
                        .Source = "SELECT * FROM orderdata_sorting WHERE shipper ='" & Me!search_mado & "'And delivery_name = '" & Me!delivery_mado & "' And pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#"
            
            ElseIf hantei = 11 Then   ' 集荷日+配達日
                        .Source = "SELECT * FROM orderdata_sorting WHERE pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#" & "And delivery_date Between #" & Me!delivery_date_start & "# AND #" & Me!delivery_date_end & "#"

            ElseIf hantei = 1000 Then   ' 業者
                        .Source = "SELECT * FROM orderdata_sorting WHERE " & naiyou
            
            ElseIf hantei = 11000 Then   ' 業者+配達先
                        .Source = "SELECT * FROM orderdata_sorting WHERE delivery_name = '" & Me!delivery_mado & "' and  " & naiyou
                        
            ElseIf hantei = 11001 Then   ' 業者+配達先+集荷日
                        .Source = "SELECT * FROM orderdata_sorting WHERE delivery_name = '" & Me!delivery_mado & "' and pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#" & " and  " & naiyou
                        
            ElseIf hantei = 1001 Then   ' 業者+集荷日
                        .Source = "SELECT * FROM orderdata_sorting WHERE pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#" & " and  " & naiyou

            ElseIf hantei = 1101 Then   ' 出荷人+業者+集荷日
                        .Source = "SELECT * FROM orderdata_sorting WHERE  shipper ='" & Me!search_mado & "' And pu_date Between #" & Me!pu_date_start & "# AND #" & Me!pu_date_end & "#" & " and  " & naiyou

'                                                    Debug.Print .Source
            Else
             MsgBox "設定外の抽出項目です。設定し直して再抽出してください。"
             Exit Sub
            End If

            .LockType = adLockOptimistic
            .CursorType = adOpenKeyset
            .Open
            End With

        Set Me.Recordset = rs
        rs.Close: Set rs = Nothing
        cn.Close: Set cn = Nothing

ExitErr_Handler:
        Exit Sub

Err_Handler:
        MsgBox "エラー： " & Err.description
        rs.Close: Set rs = Nothing
        cn.Close: Set cn = Nothing

End Sub

抽出したレコードソースを更新すると・・・

抽出たレコードをVBAコードで更新などをする時は、レコードを再抽出しないと更新したデータが表示されていません。

なので、更新後に、本当のレコードをレコードソースにする必要があります。

抽出を解除するときと同じコードを使えばいいので、Publicにして使っています。

Private Sub 解除ボタン_Click()

On Error GoTo Err_Handler

    Set cn = CurrentProject.AccessConnection
    Set rs = New ADODB.Recordset

            With rs
            Set .ActiveConnection = cn
            .Source = "orderdata_sorting"
            .LockType = adLockOptimistic
            .CursorType = adOpenKeyset
            .Open
            End With

        Set Me.Recordset = rs
        rs.Close: Set rs = Nothing
        cn.Close: Set cn = Nothing

ExitErr_Handler:
        search_mado = ""
        trader_search = ""
        delivery_mado = ""
        pu_date_start = ""
        pu_date_end = ""
        delivery_date_start = ""
        delivery_date_end = ""

        Exit Sub
Err_Handler:
        MsgBox "エラー： " & Err.description
        rs.Close: Set rs = Nothing
        cn.Close: Set cn = Nothing
End Sub

そうすると問題なのが、

帳票フォームなどにしている場合は、カーソルがレコードの先頭に行ってしまうので、スクロールして値が変わった事を確認しないとならないのです。

また、Accessを再起動しても、抽出されたレコードソースは解除しないかぎり抽出されたままのフォームデータなので、自分の場合は、フォームを開く時に、この解除のVBAを動かすようにしています。

なので、抽出する場合は、数件程度のレコードになるようにするくらいの条件設定が必要だと考えます。

もしくは、もっと良い方法があるなら教えてほしい。

もっとスマートにやる方法は無いのか？

どうも、Accessというソフトは、帳票フォームにすると一気に使いづらくなります。

通常作業としては、帳票フォームで条件を絞ったのちに、エクセルのように、上から順々に処理をしていきたい事が多いと思います。

しかし、VBAコードなどでデータ更新をかけると画面を再表示させない限り、データが最新になりません。

テーブルをダイレクトに更新するってやり方ならいいのかもしれませんが、それはそれでヒューマンミスが怖いです。

します。