アクセス小僧：レコードコピー

アクセスのフォームに設置したボタンを押したら、新しいレコードを作成し、カレントレコードの内容をコピーするマクロを過去に作りました。

そのマクロに、倉庫No.を指定したら、バックアップ用テーブルから、指定されたレコードをコピーするコードを追加しました。

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

・バックアップ用のテーブルには、元のテーブルと同じ名前のフィールドがあります。

・但し、元のテーブルの主キー(PW_Mng_ID)は、バックアップ用のテーブルのPW_Mng_ID_oldに退避します。

マクロを以下に示します。

【マクロ】
Sub RecordCopy1()
'【機能】カレントレコードをコピーして、新しいレコードを作る
'【変数】
  Dim rs As New ADODB.Recordset
  Dim rsC As ADODB.Recordset
  Dim i As Long
  Dim Ans1 As Long ' 答え
  Dim db1 As DAO.Database
  Dim rs1 As DAO.Recordset
  Dim strSQL As String ' SQL文字列
'【実行コード】
  If IsNull(Controls("倉庫No").Value) Then
    Ans1 = MsgBox("カレントレコードをコピーします。", vbInformation, "情報")
    rs.Source = "SELECT * FROM T_パスワード管理 WHERE PW_Mng_ID = " & [PW_Mng_ID] & ";"
    rs.Open , CurrentProject.Connection, adOpenStatic, adLockOptimistic
    If (Not rs.EOF) Then
      Set rsC = rs.Clone
      rsC.AddNew
      For i = 0 To rs.Fields.Count - 1
        Select Case rs.Fields(i).Name
        Case "PW_Mng_ID"
          ' 主キーを除外
        Case Else
          rsC(i) = rs(i)
        End Select
      Next i
      rsC.Update
      rsC.Close
      Set rsC = Nothing
    End If
    rs.Close
  Else
    If IsNumeric(Controls("倉庫No").Value) = False Then
      Ans1 = MsgBox("倉庫No=" & Controls("倉庫No").Value & "は、数字では、ありません。", vbCritical, "警告")
      Exit Sub
    Else
      Set db1 = CurrentDb
      strSQL = "SELECT * FROM T_パスワード倉庫 WHERE PW_Save_ID IN (" & Controls("倉庫No").Value & ")"
      Set rs1 = db1.OpenRecordset(strSQL)
      Debug.Print "rs1.RecordCount=" & rs1.RecordCount & "[RecordCopy1]"
      If rs1.RecordCount = 1 Then
        Ans1 = MsgBox("倉庫No=" & Controls("倉庫No").Value & vbCrLf _
        & "題名=" & rs1.Fields("題名") & vbCrLf _
        & "のレコードをコピーします。", vbInformation, "情報")
        rs.Source = "SELECT * FROM T_パスワード管理 WHERE PW_Mng_ID = " & [PW_Mng_ID] & ";"
        rs.Open , CurrentProject.Connection, adOpenStatic, adLockOptimistic
        If (Not rs.EOF) Then
          Set rsC = rs.Clone
          rsC.AddNew
          For i = 0 To rs.Fields.Count - 1
            Select Case rs.Fields(i).Name
            Case "PW_Mng_ID"
              ' 主キーを除外
            Case Else
              rsC(i) = rs1.Fields(rs.Fields(i).Name)
            End Select
          Next i
          rsC.Update
          rsC.Close
          Set rsC = Nothing
        End If
        rs.Close
        rs1.Close
        Set rs = Nothing
        Set rs1 = Nothing
        db1.Close
        Set db1 = Nothing ' 解放
      Else
        Ans1 = MsgBox("倉庫No=" & Controls("倉庫No").Value & "のレコードが見つかりません。", vbCritical, "警告")
        Exit Sub
      End If
    End If
  End If
End Sub

タグ：レコードコピー VBA アクセス

コメント 1

ヤバイぜ！　ありがとうございます(^_0)ノ
by cheese999 (2020-03-17 07:31)