パソコン情報

【Access】非連結フォームにてADOでSQL抽出させるにはコツがあった！

完全版を表示する

やりたい事は、検索して更新する事

 

ココがポイント

商品テーブルの値を非連結のフォームに呼び出して、更新した内容を商品テーブルに上書きする

ということがやりたかった。

 

テキスト見ながらADOでの更新をやってみたが、エラーが出てダメ

 

Private Sub edit_btn_Click()

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SQL As String

    If MsgBox("修正登録しますか？ yes/no", vbYesNo, "データ修正確認") = vbYes Then

On Error GoTo ErrRtn

        SQL = "SELECT * FROM dbo_product_master WHERE no = " Me!edit_no &""

        Set cn = CurrentProject.Connection
        rs.Open SQL, cn, adOpenKeyset, adLockOptimistic

'        Set Me.Recordset = rs

                rs!code = Me!edit_code
                rs!code_ec = Me!edit_code_ec
                rs!code_amazon = Me!edit_code_amazon
                rs!jan_sku_code = Me!edit_jan_sku_code
                rs!name = Me!edit_name
                rs!name_kana = Me!edit_name_kana
                rs!categories = Me!edit_categories.Column(1)
                rs!item = Me!edit_item.Column(1)
                rs!purchase_price = Me!edit_purchase_price
                rs!purchase_currency = Me!edit_purchase_currency.Column(1)
                rs!selling_price = Me!edit_selling_price
                rs!supplier = Me!edit_supplier.Column(1)
                rs!shipping_flag = Me!edit_shipping_flag.Column(1)
                rs!handling = Me!edit_handling.Column(1)

        ' トランザクションの保存
        cn.CommitTrans

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

    Else

            MsgBox ("修正登録しませんでした。")
            Exit Sub

    End If

ExitErrRtn:
        MsgBox ("新規登録完了しました。")

Exit Sub

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

End Sub

 

 

今までの経験では、

さらに詳しく

SQLでのWHERE句の後の条件が間違っている事が多かった！

＆マークやら、カンマやら、いろいろとちょっとしたことで求める値が検索できなかったものです。

 

SQLで絞るとレコードが無いというエラー

SQL = "SELECT * FROM dbo_product_master WHERE no = " Me!edit_no &;""

 

のように、最初にSQLで絞ってしまうやり方ですと、

 

ココに注意

BOFとEOFのいずれかがTrueになっているか、または現在のレコードが削除されています。要求された操作には、現在のレコードが必要です。

 

となります。なんの意味かわかりませんでしたが、デバッグ（Debug.Printを適当に設置して確認）していてレコードが無いという事がわかりました。

 

つまり、BOFとか、DOFってのは、レコードの頭か後ろが無いよって言っているようです。

確かに、レコードセット内のレコードが無いのに更新かけてもエラーになりますよね。

 









ADOでのSQLで抽出するにはコツ

 

ごめんなさい！

スキルが無くてテキストにも乗っているやり方でやってダメだったので、なぜダメなのかがわかりませんでしたが、最初にSQLで絞るやり方ではなく、レコードセットにテーブルを設置してから、フィルターで絞るやり方ならすんなりとできるようになりました。

 

 

Private Sub edit_btn_Click()

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SQL As String

    If MsgBox("修正登録しますか？ yes/no", vbYesNo, "データ修正確認") = vbYes Then

On Error GoTo ErrRtn

        Set cn = CurrentProject.Connection
        rs.CursorLocation = adUseClient
        rs.Open "dbo_product_master", cn, adOpenKeyset, adLockOptimistic

                rs.Filter = "no = " &edit_no

        ' トランザクションの開始
        cn.BeginTrans

                rs!code = Me!edit_code
                rs!code_ec = Me!edit_code_ec
                rs!code_amazon = Me!edit_code_amazon
                rs!jan_sku_code = Me!edit_jan_sku_code
                rs!name = Me!edit_name
                rs!name_kana = Me!edit_name_kana
                rs!categories = Me!edit_categories.Column(1)
                rs!item = Me!edit_item.Column(1)
                rs!purchase_price = Me!edit_purchase_price
                rs!purchase_currency = Me!edit_purchase_currency.Column(1)
                rs!selling_price = Me!edit_selling_price
                rs!supplier = Me!edit_supplier.Column(1)
                rs!shipping_flag = Me!edit_shipping_flag.Column(1)
                rs!handling = Me!edit_handling.Column(1)

        rs.Update

        ' トランザクションの保存
        cn.CommitTrans

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

    Else

            MsgBox ("修正登録しませんでした。")
            Exit Sub

    End If

ExitErrRtn:
        MsgBox ("新規登録完了しました。")

Exit Sub

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

End Sub

 

 

rs.Filter = "no = " & edit_no

 

ポイントは、

 

ココがポイント

レコードセットに乗ったデータを上VBAでフィルターをかける

ところですね。

 

掲載しているVBAは、更新をしたときのものですが、これで、ADOの場合は、検索もできることが確認できました。

なぜにテキストにも乗っているような事ができないのは不思議ですが、この方法でできるので良しとします。