SSブログ

アクセス小僧:レコード削除 [コンピューター]

アクセスのフォームに設置したボタンを押したら、表示している1レコードを削除するマクロがあったのですが、削除した後に、元に

戻したくなることもあるだろう、ということで、別テーブルを用意して、そこに削除するレコードの情報をコピーするコードを追加しました。

テーブル名主キー
元のテーブルT_パスワード管理PW_Mng_ID
バックアップ用のテーブルT_パスワード倉庫PW_Save_ID

・バックアップ用のテーブルには、元のテーブルと同じ名前のフィールドがあります。
・但し、元のテーブルの主キー(PW_Mng_ID)は、バックアップ用のテーブルのPW_Mng_ID_oldに退避します。


【マクロ】
Private Sub レコード削除_Click()
  '【変数】
  Dim db1 As DAO.Database
  Dim rs1 As DAO.Recordset
  Dim rs_bu As DAO.Recordset ' バックアップ用のレコードセット
  Dim Ans1 As Long ' 答え
  Dim Str1 As String
  Dim strSQL As String ' SQL文字列
  Dim myID1(2) As Long ' 主キー
  Dim AbsPos1 As Long ' レコード番号
  Dim RcdCnt1 As Long ' レコード数
  Dim IDmin1 As Long
  Dim i As Long ' 整数
  '【実行コード】
  Debug.Print "--- レコード削除_Click(Start) ---"
  myID1(0) = [PW_Mng_ID]
  Debug.Print "myID1(0)=" & myID1(0) & "[レコード削除_Click]"
  Debug.Print "Me.NewRecord=" & Me.NewRecord & "[レコード削除_Click]"
  If Me.NewRecord = True Then
    Ans1 = MsgBox("新規レコード(PW_Mng_ID=" & myID1(0) & ")は削除できません。[レコード削除_Click]", vbOKOnly)
    Debug.Print "--- レコード削除_Click(Exit, 新規レコード) ---"
    Exit Sub
  End If
  Ans1 = MsgBox("PW_Mng_ID=" & myID1(0) & "を削除してもよろしいですか? [レコード削除_Click]", vbYesNo + vbInformation, "確認")
  If Ans1 = vbNo Then
    Debug.Print "--- レコード削除_Click(Exit, No) ---"
    Exit Sub
  End If
  '
  Ans1 = MsgBox("PW_Mng_ID=" & myID1(0) & "をバックアップしますか? [レコード削除_Click]", vbYesNo + vbInformation, "確認")
  If Ans1 = vbYes Then
    Set db1 = CurrentDb
    Set rs_bu = db1.OpenRecordset("T_パスワード倉庫", dbOpenDynaset)
    rs_bu.AddNew ' バックアップ用レコードを追加
    For i = 0 To rs_bu.Fields.Count - 1
      Select Case rs_bu.Fields(i).Name
        Case "PW_Save_ID"
          ' T_パスワード倉庫テーブルの主キーを除外
        Case "PW_Mng_ID_old"
          ' T_パスワード管理テーブルの主キーを退避
          rs_bu(i) = Controls("PW_Mng_ID")
        Case Else
          'それ以外のフィールドを退避
          rs_bu(i) = Controls(rs_bu.Fields(i).Name)
      End Select
    Next i
    rs_bu.Update
    rs_bu.Close
    Set rs_bu = Nothing ' 解放
    db1.Close
  Set db1 = Nothing ' 解放
  End If
  '
  AbsPos1 = IDtoAbsPos1("T_パスワード管理", "PW_Mng_ID", myID1(0)) ' レコード番号
  Debug.Print "AbsPos1=" & AbsPos1 & "[レコード削除_Click]"
  Set db1 = CurrentDb
  Set rs1 = db1.OpenRecordset("T_パスワード管理", dbOpenDynaset)
  rs1.MoveFirst ' 先頭レコードへ
  rs1.MoveLast ' 最終レコードへ
  rs1.MoveFirst ' 先頭レコードへ
  rs1.Move AbsPos1 ' 削除しようとしているレコードに移動
    ' レコード削除後に履歴に残すIDを決める
  RcdCnt1 = rs1.RecordCount ' レコード数
  Debug.Print "RcdCnt1=" & RcdCnt1 & "[レコード削除_Click]"
  If RcdCnt1 >= 2 Then
    If AbsPos1 = 0 Then
      rs1.Move 1 ' 先頭レコードなら、次のレコードへ
    Else
      rs1.Move -1 ' 先頭レコードでないなら、前のレコードへ
    End If
  Else
    MsgBox "レコード数=" & RcdCnt1 & "なので、レコード削除を中止します。"
    rs1.Close
    Set rs1 = Nothing ' 解放
    db1.Close
    Set db1 = Nothing ' 解放
    Debug.Print "--- レコード削除_Click(Exit) ---"
    Exit Sub
  End If
  Debug.Print "rs1.AbsolutePosition=" & rs1.AbsolutePosition & "[レコード削除_Click]"
  myID1(1) = rs1![PW_Mng_ID]
  Debug.Print "myID1(1)=" & myID1(1) & "[レコード削除_Click]"
  rs1.Close
  Set rs1 = Nothing ' 解放
  ' レコード削除
  Str1 = "SELECT * FROM T_パスワード管理 WHERE PW_Mng_ID IN (" & myID1(0) & ")"
  Set rs1 = db1.OpenRecordset(Str1)
  Debug.Print "rs1.RecordCount=" & rs1.RecordCount & "[レコード削除_Click]"
  If rs1.RecordCount = 1 Then
    rs1.Edit
    rs1.Delete
    rs1.Close
    Set rs1 = Nothing ' 解放
  Else
    Set rs1 = Nothing ' 解放
    db1.Close
    Set db1 = Nothing ' 解放
    Debug.Print "--- レコード削除_Click(Exit) ---"
    Exit Sub
  End If
  ' 削除するレコード以外のIDの中で最小のものを探す。
  strSQL = "SELECT MIN(PW_Mng_ID) AS IDmin FROM T_パスワード管理 WHERE PW_Mng_ID <> " & myID1(0)
  Set rs1 = CurrentDb.OpenRecordset(strSQL)
  If rs1.RecordCount = 1 Then
    IDmin1 = rs1![IDmin]
    Debug.Print "IDmin1=" & IDmin1
    rs1.Close
    Set rs1 = Nothing ' 解放
  Else
    Set rs1 = Nothing ' 解放
    db1.Close
    Set db1 = Nothing ' 解放
    Debug.Print "--- レコード削除_Click(Exit) ---"
    Exit Sub
  End If
  ' 履歴の中の削除したレコードのIDを書き換え
  strSQL = "SELECT * FROM T_PWMngID WHERE PW_Mng_ID1 =" & myID1(0)
  Set rs1 = CurrentDb.OpenRecordset(strSQL)
  If rs1.RecordCount >= 1 Then
    rs1.MoveFirst
    Do Until rs1.EOF
      rs1.Edit
      rs1![PW_Mng_ID1] = IDmin1
      rs1.Update
      rs1.MoveNext
    Loop
  End If
  rs1.Close
  Set rs1 = Nothing ' 解放
  ' 履歴変更
  'Set rs1 = db1.OpenRecordset("T_PWMngID", dbOpenDynaset)
  'rs1.MoveFirst ' 先頭レコードへ
  'rs1.MoveLast ' 最終レコードへ
  'rs1.MoveFirst ' 先頭レコードへ
  'rs1.FindFirst "PW_Mng_ID1=" & myID1(0) ' 履歴を削除するレコードのIDで探索
  'Debug.Print "rs1.AbsolutePosition=" & rs1.AbsolutePosition & "[レコード削除_Click]"
  'Debug.Print "rs1.NoMatch=" & rs1.NoMatch & "[レコード削除_Click]"
  'rs1.Edit
  'rs1![PW_Mng_ID1] = myID1(1)
  'rs1.Update
  'rs1.Close
  db1.Close
  Set db1 = Nothing ' 解放
  Call 開き直し_Click
  Debug.Print "--- レコード削除_Click(End) ---"
End Sub

【追記】
フォームのコントロールの値を参照するとき、[コントロール名]という記述をしますが、これだと、コントロール名が変化するときには使えません。そこで、Controls(コントロール名)という記述を使用しています。
ヤバイぜ!(22)  コメント(2) 
共通テーマ:パソコン・インターネット

ヤバイぜ! 22

コメント 2

cheese999

ヤバイぜ! ありがとうございます(^_0)ノ
by cheese999 (2020-03-02 06:14) 

cheese999

説明を追記しました。
(^_0)ノ
by cheese999 (2020-03-05 22:41) 

コメントを書く

お名前:[必須]
URL:
コメント:
画像認証:
下の画像に表示されている文字(英大文字の「オー」、英小文字の「ユー」、アラビア数字の「ハチ」、アラビア数字の「イチ」、アラビア数字の「ニ」)を入力してください。

Facebook コメント

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。