パソコン(ソフト)

【Access】完全一致のレコード以外は登録する履歴機能を実装する

やりたい事説明

やりたい事は、レコードに存在する複数フィールドの内、

やりたい事ポイント

複数ある指定フィールドが完全一致しない限りレコード追加

するというものであり、つまり沢山ある組み合わせ(フィールドデータの組み合わせ)のレコードを追加していきたいという事です。

 

沢山の項目組み合わせを履歴として蓄積して、次回の入力には、その組み合わせの中から選択すれば簡単に入力することができるような仕組みにしたいと思っています。

 

【具体的例】

テーブル history        [NO,shipper,pu_location,pu_destination,delivery_name,trader,request_store,count]

※NOは自動採番、countは、履歴が使用される毎にカウントアップ用
※2から6フィールドを判別

1,teikoku,souko,tokyo,okinawa,net,fuji,0
2,teikoku,souko,tokyo,hokkaido,net,fuji,0・・・(追加)
3,teikoku,souko,tokyo,okinawa,net,alups,0・・・(追加)

4,teikoku,souko,tokyo,hokkaido,net,fuji,0・・・(2と同じパターンなので無視)

 

登録時の判別VBA

Sub add_judgement()

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim st1 As Integer
Dim st2 As Integer
Dim st3 As Integer
Dim st4 As Integer
Dim st5 As Integer
Dim st6 As Integer

On Error GoTo ErrRtn

                     'アクションクエリ非表示設定
                        DoCmd.SetWarnings False
            
If IsNull(shipper_jg) Or IsNull(pu_location_jg) Or IsNull(pu_destination_jg) Or IsNull(delivery_name_jg) Or IsNull(request_store_jg) Or IsNull(trader_jg) Then
    Exit Sub
End If

If DCount("*", "history", "shipper = " & shipper_jg) = 0 Then
        st1 = 0
    Else
        st1 = 1
End If

If DCount("*", "history", "pu_location = " & pu_location_jg) = 0 Then
        st2 = 0
    Else
        st2 = 1
End If

If DCount("*", "history", "pu_destination = " & pu_destination_jg) = 0 Then
        st3 = 0
    Else
        st3 = 1
End If

If DCount("*", "history", "delivery_name = " & delivery_name_jg) = 0 Then
        st4 = 0
    Else
        st4 = 1
End If

If DCount("*", "history", "request_store = " & request_store_jg) = 0 Then
        st5 = 0
    Else
        st5 = 1
End If

If DCount("*", "history", "trader = " & trader_jg) = 0 Then
        st6 = 0
    Else
        st6 = 1
End If


If (st1 + st2 + st3 + st4 + st5 + st6) = 6 Then
    Exit Sub
Else
            
                Set cn = CurrentProject.Connection
                Set rs = New ADODB.Recordset
                rs.Open "history", cn, adOpenKeyset, adLockOptimistic
                
                    ' トランザクションの開始
                    cn.BeginTrans

                    rs.AddNew

                    rs!shipper = shipper_jg
                    rs!pu_location = pu_location_jg
                    rs!pu_destination = pu_destination_jg
                    rs!delivery_name = delivery_name_jg
                    rs!trader = trader_jg
                    rs!request_store = request_store_jg

                    rs.Update
                    
                    ' トランザクションの保存
                    cn.CommitTrans
                
                rs.Close: Set rs = Nothing
                cn.Close: Set cn = Nothing
End If

ExitErrRtn:
    MsgBox ("初パターンの為、履歴追加しました!")
    Exit Sub

ErrRtn:
    MsgBox "エラー: " & Err.description
    'BeginTransの時点まで戻り、変更をキャンセルする
    cn.RollbackTrans
    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing
End Sub

 

フィールド名_jg というのが、フォーム上に設置したテキストボックスになります。

DCount("*", "history", "shipper = " & shipper_jg) = 0

このコードから、テキストボックスに入力されたデータとhistoryテーブルに登録されているデータを比較して、

ココがポイント

フィールドに登録ありか?否かを判別しています

そして、登録有無で、変数に0か1かを代入しています。

なぜ変数にしているかと言えば、同じフィールドに同じデータが2個以上存在する場合もあるので、シンプルに重複データが有る無だけを判別したいので、0か1に変換しています。

 

If (st1 + st2 + st3 + st4 + st5 + st6) = 6 Then
     Exit Sub
Else
     登録VBAコード
End If

上のVBAコードで、変数を加算した数値が、6の時(完全一致した時)だけ登録VBAは実行されないようにしています。

 

調べても中々同じ例題が無い

レコードの完全一致

最初は変数を使わないで何とかできないものかと試行錯誤していましたが、中々、その発想にたどり着くまで時間がかかりました。

ネット上でも探し回りましたが、フィールドの1項目だけ一致したものとか、クエリを使った方法なら可能でしたが、VBAで処理した物は見つかりませんでした。

変数を使えば簡単に処理できる事でしたが、思った以上に時間がかかったので記事にしてみました。

 

 

-パソコン(ソフト)
-, , , , , , , , ,

Translate »

© 2021 PCTips