Access (VBA)

Access VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Access 2010)
新しいデータの追加と既存データの更新
投稿日時: 17/09/01 18:49:36
投稿者: MJ

いつもお世話になります。
 
フォームからデータを入力し、テーブルへ保存する際に、
フォーム項目(txt注文書No_前)に、テーブルにある
既存データの注文番号がある場合、その既存データの
有効フラグをFalseにしたい、と思っています。
 
保存したいテーブルは、T_保存
入力しているフォームは、Frm_shinki
更新したい既存データの項目は、有効フラグです
最初に、注文番号を管理するテーブルから採番してから
テーブルに登録しています。
 
オブジェクトが開いている間は更新できないというエラーが
出たので、Closeのコードを追加してみたのですが
今度は演算子がありません、、、といわれました、、
アドバイスをいただけましたら幸いです。
 
(途中、ちょっとはしょっていますがコードはこちらです)
 
---------------------------------------------------
Public Sub cmd保存_Click()
 
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim stSQL As String
 
'--注文番号を新たに取得してセット--
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
 
rs.Open "T_注文番号", cn, adOpenStatic, adLockOptimistic
    rs.AddNew
        rs!注文番号取得日時 = Now
            rs.Update
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing
 
 
Me.txtID = DMax("ID", "T_注文番号")
Me.txt注文日 = DLookup("[注文番号取得日時]", "T_注文番号", "[ID] = " & Forms!Frm_shinki![txtID])
Me.txt注文書No = "17AP" & (Format(Forms!Frm_shinki![txtID], "00000"))
 
 
If MsgBox("データを新規に登録します。よろしいですか?", vbQuestion + vbYesNo, "登録の確認") = vbYes Then
 
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
    rs.Open "T_保存", cn, adOpenStatic, adLockOptimistic
        rs.AddNew
 
rs!ID = Me.ID
:
:
:
(テーブルへデータを代入しています)
 
 
'前注文書の有効フラグを「無効」にする
 
    stSQL = "Select * From T_保存 WHERE 注文書No=" & Me.txt注文書No_前
    rs.Open stSQL, cn, adOpenDynamic, adLockBatchOptimistic
 
    Set Me.Recordset = rs
    rs!有効フラグ = False
 
rs.Update
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing
 
MsgBox "登録が完了しました。", vbInformation, "登録完了"
 
End Sub

回答
投稿日時: 17/09/04 10:11:30
投稿者: sk

引用:
フォームからデータを入力し、テーブルへ保存する際に、
フォーム項目(txt注文書No_前)に、テーブルにある
既存データの注文番号がある場合、その既存データの
有効フラグをFalseにしたい、と思っています。

引用:
入力しているフォームは、Frm_shinki

・[Frm_shinki]は連結フォームか、それとも非連結フォームか。
 
・[Frm_shinki]が連結フォームである場合、
 そのレコードソースはどのテーブルであるか。
 
引用:
最初に、注文番号を管理するテーブルから採番してから
テーブルに登録しています。

引用:
rs.Open "T_注文番号", cn, adOpenStatic, adLockOptimistic
rs.AddNew
rs!注文番号取得日時 = Now
rs.Update

引用:
Me.txtID = DMax("ID", "T_注文番号")

・[T_注文番号]の[ID]のデータ型はオートナンバー型なのか。
 
引用:
テーブルにある既存データの注文番号

引用:
Me.txt注文書No = "17AP" & (Format(Forms!Frm_shinki![txtID], "00000"))

引用:
stSQL = "Select * From T_保存 WHERE 注文書No=" & Me.txt注文書No_前

・[T_保存]の[注文書No]のデータ型がテキスト型であるならば、
 テキストボックス[txt注文書No_前]の値は
 SQL 文の中では文字列リテラルとして扱われるように
 文字列連結を行なう必要がある。
 
--------------------------------------------------------------------------
 
stSQL = "Select * From T_保存 WHERE 注文書No='" & Me.txt注文書No_前 & "'"
 
--------------------------------------------------------------------------
 
・また、テキストボックス[txt注文書No_前]の値が Null である場合や、
 該当するレコードが存在していなかった場合のフロー制御が行われていない。
 
引用:
Set Me.Recordset = rs

・上記のステートメントは何のために記述しているのか。
 「無効」扱いとなった[T_保存]のレコードを
 [Frm_shinki]と連結させ、画面上に表示するためか。
 (単に[有効フラグ]の値を False に更新するだけならば不要であるはず)

投稿日時: 17/09/04 11:00:08
投稿者: MJ

skさん
 
いつもお世話になっております。
ご回答をありがとうございます。
 
ご質問の件を、まとめて記載させていただきますと
 
 
・[Frm_shinki] は[非連結フォーム]です
・[Frm_shinki] のレコードソースは、[T_保存] です
・[T_注文番号] の[ID] は[オートナンバー型] です
 
 
なお、ご指摘いただいたとおり、[T_保存]の[注文書No]は
テキスト型です。
 
文字列連結ですね、、よく失念するところです。
まだ理解できていないことが自覚できました。
ありがとうございます。
 
 
また、テキストボックス[txt注文書No_前]がNullである
場合を考えていませんでした。
stSQLの前に、If IsNull...といった条件を付与すること
になりますか?
 
または、事前に更新クエリを作成して実行するほうが
良いのか、とも考えています。
この場合は、[txt注文書No_前]に一致したデータのみ
更新されることになると思うので、その場合は
フロー制御というのは不要と思っていますが
良いでしょうか。
 
 
 

回答
投稿日時: 17/09/04 11:40:40
投稿者: sk

引用:
・[Frm_shinki] は[非連結フォーム]です
・[Frm_shinki] のレコードソースは、[T_保存] です

レコードソースが設定されているのが「連結フォーム」、
レコードソースが設定されていないのが「非連結フォーム」ですが、
結局どちらなのでしょうか。
 
引用:
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open "T_保存", cn, adOpenStatic, adLockOptimistic
rs.AddNew

仮に[Frm_shinki]が[T_保存]をレコードソースとする
連結フォームなのであれば、少なくとも上記のコードは
あまり適切ではないように思えるのですが。
([Frm_shinki]と連結している[T_保存]のカレントレコードを
 編集しながら、そのレコードとは別に新規レコードを
 追加しようとしている)

投稿日時: 17/09/04 13:06:02
投稿者: MJ

skさん
 
すみません、勘違いしておりました。
[Frm_shinki] は[非連結フォーム]です。

回答
投稿日時: 17/09/04 13:26:36
投稿者: sk

引用:
[Frm_shinki] は[非連結フォーム]です。

引用:
[T_注文番号] の[ID] は[オートナンバー型] です

引用:
[T_保存]の[注文書No]はテキスト型です。

(フォームモジュール)
-----------------------------------------------------------------
Private Sub cmd保存_Click()
On Error GoTo Err_cmd保存_Click
 
    Dim cn As ADODB.Connection
    Dim rs1 As ADODB.Recordset
    Dim rs2 As ADODB.Recordset
    Dim rs3 As ADODB.Recordset
    Dim stSQL As String
    Dim stMsg As String
    Dim dtNow As Date
    Dim lngNewID As Long
      
    Set cn = CurrentProject.Connection
      
    '[txt注文書No_前]の値が Null でも空文字列でもない場合
    If Nz(Me.txt注文書No_前, "") <> "" Then
        'テーブル[T_保存]から「前の注文書」に当たるレコードを参照
        Set rs1 = New ADODB.Recordset
        stSQL = "SELECT * FROM [T_保存]" & _
                " WHERE [注文書No]='" & Me.txt注文書No_前 & "'" & _
                " AND [有効フラグ]=True"
        rs1.CursorLocation = adUseClient
        rs1.Open stSQL, cn, adOpenDynamic, adLockOptimistic
        '該当するレコードが存在しない場合
        If rs1.EOF = True Then
            '参照解放
            rs1.Close: Set rs1 = Nothing
            cn.Close: Set cn = Nothing
            'エラーメッセージを表示
            stMsg = "前の注文書番号に該当するレコードが見つかりません。" & vbCrLf & _
                    "前の注文書番号が誤って入力されているか、" & _
                    "その注文書が既に無効になっている可能性があります。"
            MsgBox stMsg, vbExclamation, "エラー"
            '[txt注文書No_前]にフォーカスを移動
            Me.txt注文書No_前.SetFocus
            'プロシージャを抜ける
            Exit Sub
        End If
    End If
          
    'トランザクション開始
    cn.BeginTrans
    On Error GoTo RollBack_cmd保存_Click
          
    '現在のシステム日時を変数 dtNow に代入
    dtNow = Now()
          
    '注文番号を新たに取得
    Set rs2 = New ADODB.Recordset
    With rs2
        .CursorLocation = adUseClient
        .Open "T_注文番号", cn, adOpenStatic, adLockOptimistic
        .AddNew
        ![注文番号取得日時] = dtNow
        .Update
        '新規レコードの[ID]の値を変数 lngNewID に代入
        lngNewID = ![ID]
    End With
     
    '新規保存するレコードの[ID],[注文日],[注文書No]の値を
    'フォーム上の各テキストボックスの値に代入
    Me.txtID = lngNewID
    Me.txt注文日 = dtNow
    Me.txt注文書No = "17AP" & Format(lngNewID, "00000")
      
    '[T_保存]の参照及び[ID]の競合チェック
    Set rs3 = New ADODB.Recordset
    With rs3
        stSQL = "SELECT * FROM [T_保存]" & _
                " WHERE [ID]=" & lngNewID
        .CursorLocation = adUseClient
        .Open stSQL, cn, adOpenStatic, adLockOptimistic
        '[ID]の値が既に他のレコードで使用されている場合
        If .EOF = False Then
            'ロールバック
            cn.RollbackTrans
            'エラーメッセージを表示
            stMsg = "IDが他のレコードが競合しています。" & vbCrLf & _
                    "[T_注文番号]と[T_保存]のそれぞれの内容を確認して下さい。"
            MsgBox stMsg, vbExclamation, "エラー"
            '終了処理へ
            GoTo Exit_cmd保存_Click
        End If
    End With
     
    '登録確認ダイアログの表示
    If MsgBox("データを新規に登録します。よろしいですか?", _
              vbQuestion + vbYesNo, _
              "登録の確認") = vbNo Then
        '[いいえ]ボタンがクリックされたら
        'ロールバックして終了処理へ
        cn.RollbackTrans
        GoTo Exit_cmd保存_Click
    End If
     
    '前注文書のレコードを参照している場合
    If Not rs1 Is Nothing Then
        '前注文書の有効フラグを「無効」にする
        rs1![有効フラグ] = False
        rs1.Update
    End If
     
    '新規レコードの追加
    With rs3
        .AddNew
        ![ID] = Me.txtID
        ![注文書No] = Me.txt注文書No
        ![注文日] = Me.txt注文日
        ![有効フラグ] = True
        .Update
    End With
  
    'コミット
    cn.CommitTrans
    On Error GoTo Err_cmd保存_Click
     
    '完了メッセージの表示
    MsgBox "登録が完了しました。", _
           vbInformation, _
           "登録完了"
 
'終了処理
Exit_cmd保存_Click:
On Error Resume Next
     
    '参照解放
    rs3.Close: Set rs3 = Nothing
    rs2.Close: Set rs2 = Nothing
    rs1.Close: Set rs1 = Nothing
    cn.Close: Set cn = Nothing
     
    'プロシージャを抜ける
    Exit Sub
 
'ロールバック処理(実行時エラー発生時)
RollBack_cmd保存_Click:
    cn.RollbackTrans
 
'エラー時処理
Err_cmd保存_Click:
     
    'エラーの番号と説明を表示
    stMsg = Err.Number & ": " & Err.Description
    Debug.Print Err.Number & ": " & Err.Description
    MsgBox stMsg, _
           vbCritical, _
           "実行時エラー(" & Me.Name & ".cmd保存_Click)"
     
    '終了処理へ
    Resume Exit_cmd保存_Click
End Sub
-----------------------------------------------------------------
 
以上のようなコードを実行なさればよろしいかと。

投稿日時: 17/09/04 14:51:46
投稿者: MJ

skさん
 
今、ひとつひとつ確認させていただいております。
なるほどこういう風に設定するんですね、、
 
せっかくの機会なのでしっかり読み込んでから
仕上げたいと思います。
 
ご丁寧にありがとうございました!
 
取り急ぎ、お礼まで。。。