やりたい事は、検索して更新する事
ココがポイント
商品テーブルの値を非連結のフォームに呼び出して、更新した内容を商品テーブルに上書きする
ということがやりたかった。
テキスト見ながら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の場合は、検索もできることが確認できました。
なぜにテキストにも乗っているような事ができないのは不思議ですが、この方法でできるので良しとします。