DoCmd.SearchForRecord が動かない時の解決方法

締切済

質問者：うさぎ0122
質問日時：2022/07/22 15:31
回答数：3件

アクセスでフォームとサブフォームの複製をしたいです。
下記の様にコードを作成しましたが動作しません。
確認すると DoCmd.SearchForRecord の部分で、レコードの移動が出来ていませんでした。
DoCmd.SearchForRecord の部分だけ切り抜いて動作させた所、問題なく動きました。
DoCmd.SearchForRecord が動かない時、どんな原因が考えられるでしょうか？
ご回答よろしくお願いします！

下記コードです。

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rl As DAO.Relation
Dim maxnumber As Integer: maxnumber = 0

Dim a As Variant
Dim c As Variant

Dim vsql As String
Dim x As Variant

a = 見積ID
c = Me!Frm見積書明細.Form.Recordset.RecordCount

Set db = CurrentDb
Set rs = db.OpenRecordset("T見積書")

Do Until rs.EOF = True
If rs!見積ID > maxnumber Then
maxnumber = rs!見積ID
End If
rs.MoveNext
Loop

x = maxnumber + 1

DoCmd.RunCommand acCmdSelectRecord 'カレントレコードの選択
DoCmd.RunCommand acCmdCopy '選択レコードのコピー

DoCmd.GoToRecord , , acNewRec '新規レコードに移動

DoCmd.RunCommand acCmdSelectRecord 'カレントレコードの選択
DoCmd.RunCommand acCmdPaste
見積ID = x

↓ここの移動ができません
DoCmd.SearchForRecord , , acFirst, "見積ID ='" & a & "'"
Me!Frm見積書明細.SetFocus 'サブフォームにフォーカスを移動
DoCmd.RunCommand acCmdSelectAllRecords 'すべてのレコードを選択
DoCmd.RunCommand acCmdCopy '[コピー]を実行

DoCmd.SearchForRecord , , acFirst, "見積ID ='" & x & "'"
Me!Frm見積書明細.SetFocus
DoCmd.RunCommand acCmdPasteAppend 'コピーレコードの追加貼り付け

vsql = "update T見積書明細 "
vsql = vsql & " set 見積書ID = '" & x & "'"
vsql = vsql & " where 見積書ID is null"

db.Execute vsql, dbFailOnError

通報する

この質問への回答は締め切られました。

質問の本文を隠す

回答 (3件)

最新から表示
回答順に表示

No.3

回答者：ひでオンジ
回答日時：2022/07/22 21:09

このクエリを作るだけで良くないかい？

INSERT INTO T見積書明細 ( 見積書ID )
SELECT Max([見積ID])+1 AS 式1
FROM T見積書;

- 0
- 件

通報する

この回答へのお礼

ご返信遅くなりました！
ご回答ありがとうございます

最終目指しているのはフォームとサブフォームの複製です。
考えてる動きとしては下記の通りです。

①基レコード（フォーム）のコピー
②新レコードの作成
③新レコード（フォーム）のペースト
④基レコードに戻る
⑤基レコード（サブフォーム）のコピー
⑥新レコードに移動
⑦新レコード（サブフォーム）のペースト

フォームのデータ＝Ｔ見積書、見積ＩＤに紐づけ
サブフォームのデータ＝Ｔ見積書明細、見積書IDに紐づけ

今回聞きたいのが④のレコードに戻ることが出来ない理由です。
①、②、③は問題なく動くのですが、④が動作しません。
④を動作させるにはどうすればよいかご存じでしたら教えてください！
よろしくお願いします。