access2021 見積書 サブフォームのコピーができない

Question

実現したいこと

Accessにて見積書を作成しています。
ボタンを押すことで入力した内容をコピーし、新規レコードにて登録するコードを作成しました。
メインフォームの内容はコピーされたのですが、サブフォームの内容がコピーできません。
どのように変更すればサブフォームの内容もコピーできるでしょうか？

発生している問題・分からないこと

下記のコードを実行することでメインフォームの内容はコピーをすることができ新規のフォームにて登録されていました。
しかし、登録されていたのはメインフォームのみでサブフォームに記載されていた内容は登録されていませんでした。

※下記のようにコピーしてもサブフォームに何も表示されない

該当のソースコード

・記入したコード・
Dim MaxNumber
Dim MaxNumber2

If MsgBox("この見積をコピーしますか？", vbYesNo) = vbNo Then Exit Sub

'セーブ
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
On Error GoTo 0

'新規の番号を取得
MaxNumber = Nz(DMax("見積番号", "見積"), 0) + 1

'メインフォームをコピー
CurrentDb.Execute _
"INSERT INTO 見積 (見積番号,製品要求事項確認書No,得意先コード,品名ID,作成日,作成者,見積提出日,見積提出者,営業利益率,販売価格,備考)" _
& " SELECT " & MaxNumber & " AS NewID,製品要求事項確認書No,得意先コード,品名ID,作成日,作成者,見積提出日,見積提出者,営業利益率,販売価格,備考" _
& " FROM 見積" _
& " WHERE 見積番号=" & 見積番号


'新規の見積加工IDの番号を取得
MaxNumber2 = Nz(DMax("見積加工ID", "見積加工"), 0) + 1

'サブフォームをコピー
CurrentDb.Execute _
"INSERT INTO 見積加工 (見積加工ID,見積番号,工程コード,工数,分類名,順番)" _
& " SELECT " & MaxNumber2 & " AS NewID2," & MaxNumber & " AS NewID,工程コード,工数,分類名,順番" _
& " FROM 見積加工" _
& " WHERE 見積番号=" & 見積番号

'フォームに反映
Me.Requery
DoCmd.SearchForRecord , , , "見積番号=" & MaxNumber

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q14263689889

コードは上記のサイトを参考に作成しました。
WHEREの部分が怪しいと思いコードを変えてみました。

CurrentDb.Execute _
"INSERT INTO 見積加工 (見積加工ID,見積番号,工程コード,工数,分類名,順番)" _
& " SELECT " & MaxNumber2 & " AS NewID2," & MaxNumber & " AS NewID,工程コード,工数,分類名,順番" _
& " FROM 見積加工" _
& " WHERE 見積加工ID=" & 見積加工ID

この場合、

コンパイルエラー:
変数が定義されていません　

と表示されました。

メインフォームである「見積」の内容はコピーされていたのでサブフォームがコピーされていない。
実行自体はできるのでサブフォームをコピーする機能が動いていないと思うのですがどのように変更すればいいのかがわかりません。

補足

メインフォームの見積書
レコード内容:見積番号(主キー　オートナンバー型　見積書作成時に自動作成),製品要求事項確認書No,得意先コード,品名ID,作成日,作成者,見積提出日,見積提出者,営業利益率,販売価格,備考

サブフォームの見積加工
レコード内容:見積加工ID(主キー　オートナンバー型　加工作成時に自動作成),見積番号,工程コード,工数,分類名,順番

Microsoft Access 2021(.accdb)
データはSQL Serverにてリンク
SQL Serverで作成したテーブルを使っています。

Comments

[sk.exe]

テーブル[見積加工]の主キーはどのフィールドなのでしょうか。
仮に[見積加工ID]がそうであるとして、そのフィールドのデータ型は何でしょうか。

テーブル[見積]とテーブル[見積加工]が互いの[見積番号]を結合キーとして1対多の関係にあり、テーブル[見積]に1件の新規レコードを追加（既存の1件のレコードを元に複写）すると共に、テーブル[見積加工]に複数件の新規レコードを追加（従属する全てのレコードを元に複写）しようとしているのであれば、少なくとも後者の全てのレコードの[見積加工ID]の値を（複写されるレコードが1件のみでない限りは）同一にしてはならないはずです。

[syuu07]

コメントありがとうございます。
テーブル[見積加工]の主キーはどのフィールドなのでしょうか。
→テーブル[見積加工]の主キーは見積加工IDです。

仮に[見積加工ID]がそうであるとして、そのフィールドのデータ型は何でしょうか。
→オートナンバー型です。

後者については、

CurrentDb.Execute _
"INSERT INTO 見積加工 (見積加工ID,見積番号,工程コード,工数,分類名,順番)" _
& " SELECT " & MaxNumber2 & " AS NewID2," & MaxNumber & " AS NewID,工程コード,工数,分類名,順番" _
& " FROM 見積加工" _
& " WHERE 見積加工ID=" & 見積加工ID

複数件の新規レコードを追加する場合、こちらのコードは根本的に違うという認識で間違いないでしょうか？

Answer 1

メインフォームの見積書
レコード内容:見積番号(主キー　オートナンバー型　見積書作成時に自動作成)

サブフォームの見積加工
レコード内容:見積加工ID(主キー　オートナンバー型　加工作成時に自動作成)

とりあえず、メインフォームのフォームヘッダーセクション上に[複写コマンド]という名前のコマンドボタンが配置されていると仮定した場合。

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

    Dim strErrTitle As String
    Dim strErrMsg As String

    If Me.NewRecord = True Then
        strErrTitle = "レコード参照エラー"
        If Me.Dirty = True Then
            strErrMsg = "新規レコードの編集中です。"
        Else
            strErrMsg = "まだ編集が開始されていない新規レコードです。"
        End If
        MsgBox strErrMsg, _
               vbExclamation, _
               strErrTitle
        Exit Sub
    End If

    If MsgBox("この見積をコピーしますか？", _
              vbYesNo + vbQuestion + vbDefaultButton2) = vbNo Then
        Exit Sub
    End If

    If Me.Dirty = True Then
        DoCmd.RunCommand acCmdSaveRecord
    End If
    
    Dim ws As DAO.Workspace
    Dim db As DAO.Database

    Set ws = DBEngine.Workspaces(0)
    Set db = CurrentDb
    
    Dim rsSource As DAO.Recordset
    Dim rsDestination As DAO.Recordset
    Dim strSQL As String
    Dim lngSourceEstimateId As Long
    Dim lngNewEstimateId As Long
    
    lngSourceEstimateId = Me.見積番号
    
    '主テーブルのレコードの複写
    
    strSQL = "SELECT * FROM [見積] WHERE [見積番号] = " & lngSourceEstimateId & ";"
    Debug.Print strSQL
    Set rsSource = db.OpenRecordset(strSQL, dbOpenSnapshot)
    
    strSQL = "SELECT * FROM [見積] WHERE False;"
    Debug.Print strSQL
    Set rsDestination = db.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)
    
    'トランザクション処理の開始
    ws.BeginTrans
    '以降のコードにおいて何らかの実行時エラーが発生した場合はロールバック処理とエラー時処理を実行するようにする
    On Error GoTo RollBack_複写コマンド_Click
    
    With rsDestination
        '新規レコードの挿入
        .AddNew
        ![製品要求事項確認書No] = rsSource![製品要求事項確認書No]
        ![得意先コード] = rsSource![得意先コード]
        ![品名ID] = rsSource![品名ID]
        ![作成日] = rsSource![作成日]
        ![作成者] = rsSource![作成者]
        ![見積提出日] = rsSource![見積提出日]
        ![見積提出者] = rsSource![見積提出者]
        ![営業利益率] = rsSource![営業利益率]
        ![販売価格] = rsSource![販売価格]
        ![備考] = rsSource![備考]
        'レコードの保存
        .Update
        .MoveFirst
        '追加されたレコードのIDを取得
        lngNewEstimateId = ![見積番号]
    End With
    
    '従属テーブルのレコードの複写
   
    'テーブル[見積加工]にレコードを追加する SQL 文
    strSQL = "INSERT INTO [見積加工] ([見積番号], [工程コード], [工数], [分類名], [順番])" & _
             " SELECT " & lngNewEstimateId & " AS [新規見積番号], [工程コード], [工数], [分類名], [順番]" & _
             " FROM [見積加工]" & _
             " WHERE [見積番号] = " & lngSourceEstimateId & _
             " ORDER BY [見積加工ID];"
             
    Debug.Print strSQL
    db.Execute strSQL, dbFailOnError

    'テーブル[見積部材]にレコードを追加する SQL 文
    strSQL = "INSERT INTO [見積部材] ([見積番号], [品名ID], [品群名], [数量])" & _
             " SELECT " & lngNewEstimateId & " AS [新規見積番号], [品名ID], [品群名], [数量]" & _
             " FROM [見積部材]" & _
             " WHERE [見積番号] = " & lngSourceEstimateId & _
             " ORDER BY [見積部材ID];"
             
    Debug.Print strSQL
    db.Execute strSQL, dbFailOnError

    'コミット（ws.BeginTrans メソッドの呼び出し後以降に行われた全てのデータの変更を反映させ、トランザクション処理を終了する）
    ws.CommitTrans
    '以降のコードにおいて何らかの実行時エラーが発生した場合はエラー時処理を実行するようにする
    On Error GoTo Err_複写コマンド_Click

    Me.Requery
    DoCmd.SearchForRecord acDataForm, Me.Name, , "[見積番号]=" & lngNewEstimateId

'終了処理
Exit_複写コマンド_Click:
On Error Resume Next
    
    Set rsSource = Nothing
    Set rsDestination = Nothing
    Set db = Nothing
    Set ws = Nothing

    Exit Sub

RollBack_複写コマンド_Click:
    'ロールバック（変更された全てのデータを ws.BeginTrans メソッドの呼び出し前の状態に戻し、トランザクション処理を終了する）
    ws.Rollback

'エラー時処理
Err_複写コマンド_Click:

    strErrTitle = "実行時エラー (" & Me.Name & ".複写コマンド_Click)"
    strErrMsg = Err.Number & ": " & Err.Description
    
    Debug.Print strErrTitle
    Debug.Print strErrMsg
    
    MsgBox strErrMsg, vbCritical, strErrTitle
    
    Resume Exit_複写コマンド_Click
End Sub

Comments

[syuu07]

丁寧なご回答ありがとうございます。
無事にサブフォームのコピーができました。
制作にあたりサブフォームが増えたので下記のコードをもともと記入されていた　'従属テーブルのレコードの複写　の下に記入し実行したのですがエラーが発生してしまいました。
また、複写したレコードを行の最後に入れることでエラーなく実行自体はできましたがコピーがされていませんでした。
どのように変更すればコピーできるでしょうか？

'従属テーブルのレコードの複写

strSQL = "INSERT INTO [見積部材] ([見積番号], [品名ID], [品群名], [数量])" & _
" SELECT " & lngNewEstimateId & " AS [新規見積番号], [品名ID], [品群名], [数量]" & _
" FROM [見積部材]" & _
" WHERE [見積番号] = " & lngSourceEstimateId & _
" ORDER BY [見積部材ID];"

Debug.Print strSQL
db.Execute strSQL, dbFailOnError

'コミット
ws.CommitTrans
On Error GoTo Err_複写コマンド_Click

Me.Requery
DoCmd.SearchForRecord acDataForm, Me.Name, , "[見積番号]=" & lngNewEstimateId

実行エラー
3034: コミットまたはロールバックを実施するには、
BeginTransメソッドを使用して下さい

新しいサブフォームの見積滅菌
レコード内容:見積部材ID(主キー　オートナンバー型　部材作成時に自動作成),見積番号,品名ID,品群名,数量

[sk.exe]

ws.CommitTrans メソッド以降のコードまでコピーする必要はありません。

今回のように複数のテーブルの複数のレコードを編集（追加/更新/削除）し、それらのデータの整合性を保つ必要がある処理においては、適宜トランザクション処理を行なうようにして下さい。

[syuu07]

ご回答ありがとうございます。

丁寧なご説明のおかげで無事複数のサブフォームをコピーすることができました。
教えてくださったことは今後の勉強の参考にさせていただきます。

ここまでご回答ありがとうございました。

Answer 2

ひとまず実行したSQL文が意図した通りになっているか
確認するのが良いかと思いました。
Debug.Print を使えばイミディエイトウィンドウ（Ctrl+G）に文字列が出力されます。

Debug.Print "INSERT INTO 見積加工 (見積加工ID,見積番号,工程コード,工数,分類名,順番)" _
& " SELECT " & MaxNumber2 & " AS NewID2," & MaxNumber & " AS NewID,工程コード,工数,分類名,順番" _
& " FROM 見積加工" _
& " WHERE 見積番号=" & 見積番号

Comments

[syuu07]

コメントありがとうございます。

https://tasukete-access.com/2021/12/09/vba_immediate/
Debug.Print とイミディエイトウィンドウ（Ctrl+G）は初めて使いましたので上記のサイトを参考にコードを作成し実行しました。すると、以下のエラーが発生しました。
どのように改善すればよいでしょうか？

Private Sub 確認()

Debug.Print "INSERT INTO 見積加工 (見積加工ID,見積番号,工程コード,工数,分類名,順番)" _
& " SELECT " & MaxNumber2 & " AS NewID2," & MaxNumber & " AS NewID,工程コード,工数,分類名,順番" _
& " FROM 見積加工" _
& " WHERE 見積番号=" & 見積番号

End Sub

イミディエイトウィンドウの実行コード
call 確認

実行結果
コンパイルエラー:
SubまたはFunctionが定義されていません