ココがポイント
非連結ボックスのテキストボックスや非連結のコンボボックスの値が入力されているのか?ないのか?の判定をしてデータを抽出したい
というのが今回の目的です。
非連結テキストボックス(コンボボックス)値の有無
そんなの簡単だよって思っていましたが、自分が思うような判定ができません。
値が入っているなら、
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コードを載せておくだけになってしまっていますが、テキストだったり、日付などが複数混ざっている状態の「’」「”」「&」って本当に難しいので自分の備忘録として乗せておくことにしました。
https://pctips.jp/pc-soft/access-sql-caution/
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コードなどでデータ更新をかけると画面を再表示させない限り、データが最新になりません。
テーブルをダイレクトに更新するってやり方ならいいのかもしれませんが、それはそれでヒューマンミスが怖いです。
ココがダメ
もっとスマートに帳票フォームから値を抽出後、リアルタイムでデータ更新ができるようにならないものかと要望
します。