Accessでレコードの複製

質問

Access2010を使用して入力フォームを作成しています。

メインフォームとサブフォームにそれぞれ顧客情報を表示させていて、
「複製」ボタンを押すと、
メインフォーム、サブフォームのレコードがコピーされるようにしています。

メインフォームの元テーブルはJIK
サブフォームの元テーブルはREN
です。

JIKおよびRENテーブルはほかからリンクさせているのですが、
これで「複製」ボタンを押すと、
"実行時エラー '3022': インデックス、主キー、またはリレーションシップで重複する値が生成されるためテーブルに要求した変更でした成功しました。フィールドまたは重複データが含まれている、インデックスを削除するフィールド内のデータを変更または重複するエントリを許可して、やり直してのインデックスを再定義します。このエラーは、レポートやレポートの生成に変更を保存するときに発生します。
が出てしまいます。

テーブルをインポートすると正常に動作します。

テーブルをリンクさせる場合、レコードの複製は不可能なのでしょうか？

VBAは以下のように記述してみました。

Private Sub コマンド10_Click()
On Error GoTo Err_コマンド10_Click

Dim Result As Integer

Result = MsgBox("このデータを複製しますか？", vbYesNo + vbDefaultButton2 + vbQuestion, "データの複製確認")
If Result = vbYes Then

Me!txtCopy事件ID = Me!事件ID

Dim stDocName As String

DoCmd.RunCommand acCmdSelectRecord 'カレントレコードの選択
DoCmd.RunCommand acCmdCopy '選択レコードのコピー
DoCmd.GoToRecord , , acNewRec '新規レコードに移動
DoEvents ' （必要に応じて）
DoCmd.RunCommand acCmdPasteAppend 'コピーレコードの追加貼り付け

DoCmd.SetWarnings False ' システムメッセージ非表示
stDocName = "追加クエリ"
DoCmd.OpenQuery stDocName, acNormal, acEdit
DoCmd.SetWarnings True ' システムメッセージ表示

' サブフォーム再クエリ
Me!SREN.Requery

' 追加したレコードに移動
DoCmd.GoToRecord , , acLast
Me.リスト31.Value = Me.リスト31.ItemData(0)

MsgBox ("データを複製しました")

Exit_コマンド10_Click:
Exit Sub

Err_コマンド10_Click:
MsgBox Err.Description
Resume Exit_コマンド10_Click

Else

MsgBox "データの複製をキャンセルしました"

End If

End Sub

追加クエリは以下のように作成してみました。

【追加クエリ】
INSERT INTO REN ( 事件ID, 氏名, フリガナ, ・・・ )
SELECT [Forms]![MAIN]![事件ID] AS 式1, REN.氏名, REN.[フリガナ], REN.報告書, ・・・
FROM REN
WHERE (((REN.事件ID)=[Forms]![MAIN]![txtCopy事件ID]));

回答No.3

30246kiku · ベストアンサー

【つづき】

Me.Dirty 部分は、編集中なら保存してみて、まだ編集中なら何かあったんでしょう。
処理せずに抜けます。
オートナンバの「事件ID」が Null なら新規レコードなんでしょう。
コピーするものはないので抜けます。

フォームの表示を抑止してから
現在の「事件ID」を覚えておいてコピー処理に突入

　　With Me.Recordset
　　　　・・・・・
　　End With

部分がメインフォームに表示しているレコードのコピー処理になります。
Me.RecordsetClone　を、現在表示しているレコードに同調させます。

　　　　For i = 0 To .Fields.Count - 1
　　　　　　Select Case .Fields(i).Name
　　　　　　　　Case "事件ID"
　　　　　　　　Case Else
　　　　　　　　　　.Fields(i) = rs(i)
　　　　　　End Select
　　　　Next

部分で各フィールドの値を設定（コピー）していきますが、
「事件ID」はオートナンバなので値を設定しない様にします。
Me.Recordset　に追加したので、メインフォームでは追加したものがカレントになってます。
ということは、オートナンバ「事件ID」は新しく採番された値となります。

　　Set rs = CurrentDb.OpenRecordset("SELECT * FROM REN WHERE 事件ID=" & iSave)
　　・・・・・
　　Set rs = Nothing

部分がサブフォームの元になっているテーブル「REN」への追加になります。
テーブル「REN」の「事件ID」が、元の「事件ID」と一致するものを抽出します。
一致するものがなければ何もしません。
何かしらあったら、レコードセットの複製（ Clone ）を作ります。
これにより、フィールドの順が同じものが作られることになります。
フィールド順が同じという事は、フィールド何番目を何番目に代入・・・・
この、何番目が一緒になることを意味します。
抽出条件に一致するものがあったら、何件かわかりませんが複製元を最後に移動します。
前に向かって、抽出されたレコード数分フィールドの値を同じに（代入）していきます。

　　　　　　For i = 0 To rs.Fields.Count - 1
　　　　　　　　Select Case rs(i).Name
　　　　　　　　　　Case "連絡先ID"
　　　　　　　　　　Case "事件ID"
　　　　　　　　　　　　rsC(i) = Me.事件ID
　　　　　　　　　　Case Else
　　　　　　　　　　　　rsC(i) = rs(i)
　　　　　　　　End Select
　　　　　　Next

ここでもメインと同様に、オートナンバ「連絡先ID」なら値を設定しない様に。
また、「事件ID」は新しく採番された「Me.事件ID」を設定する様に・・・・
（「Me.事件ID」は前述したように追加した後のものになっているので・・・）
で、サブフォーム元のテーブルに追加した後、リンク親/子フィールドが設定されていたとすると、
　　Me.Recalc
で、フォーム内（メイン/サブとも）の表示が変わったと思います。変わらなければ
> ' サブフォーム再クエリ
> Me!SREN.Requery
でも・・・
最後に、フォームの表示抑止を解除します。

専用の記述にすると、上記の様になるかと思います。
その処理専用のクエリを作成して・・・・でも良いと思いますが、
最低限のフィールド名（除外するもの/値を更新するもの）がわかっていれば、
少ない記述でできるものと思います。

ただ、注意する事があって、
Clone したものに追加すると、Clone 元の最後に追加された事になるので、
Clone 元での rs.EOF 判別は、出現しない事になります。
（単に MoveNext していたのでは　・・・　ということは、無限ループに陥ることに）
何レコードを複写（コピー）するとした場合、初期レコード数分 For で MoveNext するか、
最後にいってから、前に（ MovePrevious ）前にで先頭を越すか（ While (Not rs.BOF) ）
のどちらかになると思います。

今回は、前に前に・・・の方法を提示してみました。
（抽出されるのは１件だけ・・・・であれば、MoveLast / MovePrevious 等は不要ですけど）

※ この方法での利点を挙げるとすれば、
　仕様変更等により、各テーブルのフィールド数に増減があったとしても修正しなくても良い
　（除外・更新する部分に変更あれば、修正は必要ですが・・・）

参考にする/しない等々含め、自己責任でお願いします。

蛇足１）

> DoEvents ' （必要に応じて）

このようなコメントは不要と思います。
読んでわかるレベルのものならば、コメントはない方が良いかも
コメントは、読んでもわからない理由を記述しておくものと思います。
例えば、

DoEvents ' そのまま実行すると次行で 2046 エラーになるため、一息入れる

とか？

蛇足２）

No77233.サブフォームのレコードのコピーができない
http://www.accessclub.jp/bbs/0240/beginers77233.html

にある CopyRec は、
オートナンバはない ＆ 抽出は１件を条件に、使い回しできるように・・・でした

お礼

早速ありがとうございます！
>仕様変更等により、各テーブルのフィールド数に増減があったとしても修正しなくても良い
非常に魅力的です！！

ちょっと時間がかかりそうですがやってみたいと思います。
取り急ぎお礼までです。

またご報告させていただきます。

補足

ご連絡が遅くなってしまい申し訳ありません。
大変時間がかかってしまいましたが無事に動いてます。
感動です！！
長々とおつきあいいただきありがとうございました！！

回答No.2

30246kiku

では、当時に用意していた回答でしたが・・・・参考になれば
今回手を入れてません。（２つに分かれます）
（既に対処されている部分はあるかと思います）

本回答は、後述の
> 以下余談）VBAで違う書き方してみたら・・・・ということで
のところがメインです

>【追加クエリ】
> INSERT INTO REN ( 事件ID, 氏名, フリガナ, ・・・ )
> SELECT [Forms]![MAIN]![事件ID] AS 式1, REN.氏名, REN.[フリガナ], REN.報告書, ・・・
> FROM REN
> WHERE (((REN.事件ID)=[Forms]![MAIN]![txtCopy事件ID]));

この追加クエリは正しく動く事を前提とします。とすると、

> [Forms]![MAIN]![txtCopy事件ID]
部分は、元の値

> [Forms]![MAIN]![事件ID]
部分は、新しい値

これは、メインを複製（コピー）した後に動かすものと推測できます。
（同じ「事件ID」でコピーなら、わざわざフォーム参照の記述にはしませんよね）
そこで、複製する前に行うと、同じ「事件ID」のものが追加されるだけです。
「事件ID」に主キーが設定されているのであれば、＃４さんの説明通りと思います。

＃４さんの例を使わせていただくと、本来やりたい事は
４　２　C　りんご　青森
　　↓
４　４　C　りんご　青森
と解釈しちゃいましたけど

であれば、＃３さんのお礼に記述してある処理順を入れ替えてみてどうなりますか？
なお、「コピーレコードの追加貼り付け」した後は保存した方が良さそう。
保存して、確定した「事件ID」を使った方が確かかと・・・

以下余談）VBAで違う書き方してみたら・・・・ということで

（追加クエリとかで、フィールド全部書くのが面倒・・・とか思ったら）

「JIK」テーブルの「事件ID」、および
「REN」テーブルの「連絡先ID」はオートナンバと仮定します。
以下は、コマンドボタン「btn1」がクリックされたら・・・の処理になります。
また、サブフォームコントロールのリンク親/子フィールドに「事件ID」が設定されていると仮定します。

> DoCmd.RunCommand acCmdSelectRecord 'カレントレコードの選択
> DoCmd.RunCommand acCmdCopy '選択レコードのコピー
> DoCmd.GoToRecord , , acNewRec '新規レコードに移動
> DoEvents ' （必要に応じて）
> DoCmd.RunCommand acCmdPasteAppend 'コピーレコードの追加貼り付け

部分も別の書き方にしています。
説明は後で、まずは記述を

Private Sub btn1_Click()
　　Dim rs As DAO.Recordset, rsC As DAO.Recordset
　　Dim iSave As Long
　　Dim i As Long

　　If (Me.Dirty) Then Me.Dirty = False
　　If (Me.Dirty) Then Exit Sub
　　If (IsNull(Me.事件ID)) Then Exit Sub

　　Me.Painting = False
　　iSave = Me.事件ID
　　With Me.Recordset
　　　　Set rs = Me.RecordsetClone
　　　　rs.Bookmark = .Bookmark
　　　　.AddNew
　　　　For i = 0 To .Fields.Count - 1
　　　　　　Select Case .Fields(i).Name
　　　　　　　　Case "事件ID"
　　　　　　　　Case Else
　　　　　　　　　　.Fields(i) = rs(i)
　　　　　　End Select
　　　　Next
　　　　.Update
　　　　Set rs = Nothing
　　End With

　　Set rs = CurrentDb.OpenRecordset("SELECT * FROM REN WHERE 事件ID=" & iSave)
　　If (Not rs.EOF) Then
　　　　Set rsC = rs.Clone
　　　　rs.MoveLast
　　　　While (Not rs.BOF)
　　　　　　rsC.AddNew
　　　　　　For i = 0 To rs.Fields.Count - 1
　　　　　　　　Select Case rs(i).Name
　　　　　　　　　　Case "連絡先ID"
　　　　　　　　　　Case "事件ID"
　　　　　　　　　　　　rsC(i) = Me.事件ID
　　　　　　　　　　Case Else
　　　　　　　　　　　　rsC(i) = rs(i)
　　　　　　　　End Select
　　　　　　Next
　　　　　　rsC.Update
　　　　　　rs.MovePrevious
　　　　Wend
　　　　rsC.Close
　　　　Set rsC = Nothing
　　End If
　　rs.Close
　　Set rs = Nothing

　　Me.Recalc
　　Me.Painting = True
End Sub

【つづく】

お礼

長くお時間いただいてしまいました。
お礼が大変遅くなってしまって申し訳ありません。

いただいたコードを参考に作成してみたところ
四苦八苦しながらも無事動きました～！
早速こちらを使っていきます！
長い長い書き込みいただきありがとうございました！！

回答No.1

30246kiku

過去のご質問

メインフォームとサブフォームのレコードを複製
http://okwave.jp/qa/q8229154.html

時点のフィールドの型等は同じでしょうか？
オートナンバ部分とか

当時、回答しようとして用意したものがありますが、日の目を見る事はなかったです。
それを記述すると、文字数制限に引っ掛かるようなので、どうしようか迷っています。

数回にわたって良いのなら投稿しますが、お礼率を気にされているようでしたらやめます。

※ 本質的な部分についてはわかりません

お礼

ありがとうございます！！
以前の質問もご覧いただいていたとは恐縮です！

前回はテーブルインポートなのでうまくいったのですが、
リンクさせたらうまくいかなくなってしまったことに最近気づきました。
フィールド型等は、前回の質問と変更ないです。

ぜひ回答いただきたいです！
お手数おかけしますが、よろしくお願いいたします！