フォーム上でアクティブなレコードを新規レコードとして追加(一部のフィールドは値を変更)

Sub prcCopyActiveRecordWithValuesDefinedInCase()
    Dim rst As DAO.Recordset
    Dim fld As DAO.Field

    ' 現在のフォームのRecordsetCloneを取得
    Set rst = Me.RecordsetClone
    
    ' 現在選択されているレコードに同期
    rst.Bookmark = Me.Bookmark
    
    ' 新しいレコードを開始
    rst.AddNew
    
    ' すべてのフィールドをループして、条件に応じて値を設定
    For Each fld In rst.Fields
        Select Case fld.Name
            Case "フィールドA"
                ' フィールドAの値を直接定義
                rst.Fields(fld.Name).Value = "新しい値A"
            Case "フィールドB"
                ' フィールドBの値を直接定義
                rst.Fields(fld.Name).Value = "新しい値B"
            Case Else
                ' それ以外のフィールドはそのままコピー
                rst.Fields(fld.Name).Value = fld.Value
        End Select
    Next fld
    
    ' 新しいレコードの変更を保存
    rst.Update
    
    ' 新しく追加されたレコードにフォームを同期させる(オプション)
    Me.Bookmark = rst.Bookmark

    ' オブジェクトのクリーンアップ
    Set rst = Nothing
End Sub

コメント