アクセス小僧:レコード削除 [コンピューター]
アクセスのフォームに設置したボタンを押したら、表示している1レコードを削除するマクロがあったのですが、削除した後に、元に
戻したくなることもあるだろう、ということで、別テーブルを用意して、そこに削除するレコードの情報をコピーするコードを追加しました。
【マクロ】
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(コントロール名)という記述を使用しています。
戻したくなることもあるだろう、ということで、別テーブルを用意して、そこに削除するレコードの情報をコピーするコードを追加しました。
テーブル名 | 主キー | |
元のテーブル | 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(コントロール名)という記述を使用しています。
ヤバイぜ! ありがとうございます(^_0)ノ
by cheese999 (2020-03-02 06:14)
説明を追記しました。
(^_0)ノ
by cheese999 (2020-03-05 22:41)