パソコン情報

【Access】VBAでSQL抽出して更新させようとしましたがうまく行かない時に試してみたらいいかも

 

やりたい事は、


やりたい事ポイント

フォームの非連結テキストボックスの値で、テーブルの値を更新したい




だけの処理です。

いつもなら簡単にVBAで処理できるのですが、SQLの部分でどうしても乗り越えられませんって時に試すといいかもしれませんコードです。





非連結テキストボックスの値で更新したい


stock_editというフォームの上に、select_noというdbo_arrivalというテーブルからレコードを抽出する非連結のテキストボックスと、修正したい数値が入れられる非連結テキストボックスのedit_stockというのを設置しました。

在庫修正というボタンをクリックした時にdbo_arrivalのstockフィールドの値をedit_stockの値に変更したいという処理です。




いつもならこのコードで更新できるのに・・・

Private Sub stock_edit_Click()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SQL As String

On Error GoTo ErrRtn

	If IsNull(edit_stock) Then
	MsgBox ("修正データが入力されていません。")
	Exit Sub
	End If


If MsgBox("選択NOに間違いないですか?更新しますか? yes/no", vbYesNo, "更新確認") = vbYes Then

'SQL = "SELECT * FROM dbo_arrival WHERE no = " & Forms![stock_edit]![select_no]
SQL = "SELECT * FROM dbo_arrival WHERE no =" & Me!select_no

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

        cn.BeginTrans
        
        While Not rs.EOF

        	rs!stock = edit_stock

        rs.Update
        rs.MoveNext
        Wend

        cn.CommitTrans

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

        Else
        MsgBox ("更新しませんでした。")
        Exit Sub

End If

ExitErrRtn:
    DoCmd.ShowAllRecords
    Exit Sub

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

End Sub




フォームからの値の引っ張り方でSQL抽出ができないので、色々と試してみましたが、debug.printでSQLを確認すると、

SELECT * FROM dbo_arrival WHERE no = 37


しかし、debug.print rs!stockで確認するとデータが抽出されていません。


一つのレコードを抽出するだけなので、While Not rs.EOF~Wendというループも必要ないように思えますが、外すと

注意ポイント

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



となります。

つまり、ループコードが必要とか必要じゃなく、SQLでレコードが抽出されてないのが原因のようです。

いったい何がダメなのでしょうか!?




フィルターで抽出後更新でうまく行った

Private Sub stock_edit_Click()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SQL As String

On Error GoTo ErrRtn

        If IsNull(edit_stock) Then
        MsgBox ("修正データが入力されていません。")
        Exit Sub
        End If

If MsgBox("選択NOに間違いないですか?更新しますか? yes/no", vbYesNo, "更新確認") = vbYes Then

        Set cn = CurrentProject.Connection
        rs.CursorLocation = adUseClient
        rs.Open "dbo_arrival", cn, adOpenKeyset, adLockOptimistic
 
                rs.Filter = "no = " & select_no
                
                Debug.Print rs!stock
 
        ' トランザクションの開始
           cn.BeginTrans
    
                   rs!stock = edit_stock
    
           rs.Update
 
        ' トランザクションの保存
        cn.CommitTrans

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

        Else
        MsgBox ("更新しませんでした。")
        Exit Sub

End If

ExitErrRtn:
    DoCmd.ShowAllRecords
    Exit Sub

ErrRtn:
    MsgBox "エラー: " & Err.description
    cn.RollbackTrans
    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing
    
End Sub




結局、SQLで抽出して更新じゃなく、フィルターで抽出して更新という方法になった。

テーブルサイズが巨大になった場合を考えるとどっちがいいのかわかりませんが、動かないんじゃ意味がないので、



ココがポイント

通常のやり方でダメな場合は、フィルターという方法




でも仕方ないですね。