子画面を読んだ後親画面のRecordsetClon

質問

同じレコードソースを持つ帳票フォームAとポップアップ画面Bがあり
新規作成ボタンイベントで、Aからで新規入力用のB画面を acAddNew, acDialogで開き
新規レーコドを追加する作業をして
B画面の保存ボタンを押すことでしてレコードを保存しています。

◆B画面の保存ボタンの処理
Private Sub cmd保存_Click()
　　'保存処理
　　Dim i As Long
　　Dim NewKey As Long
　　Dim SQL As String
　　Dim lngCurrentRec As Long

　　If Me.Dirty = True Then

　　　　Ret = MsgBox("入力したデータを保存しますか。", vbQuestion + vbOKCancel)
　　　　If Ret = vbCancel Then
　　　　　　cmd取消_Click
　　　　　　GoTo exitH
　　　　End If
　　　　Set Me.ClsDao_ = New ClsDao
　　　　SQL = "Select final_value, [更新日時] from T95ID管理表 "
　　　　SQL = SQL & "where "
　　　　SQL = SQL & " ID_Name = '作業記録ID';"

　　　　NewKey = Me.ClsDao_.SelectID(SQL)
　　　　Me.作業記録ID.Value = NewKey

　　　　Me.BeforeUpdate = ""
　　　　DoCmd.RunCommand acCmdSaveRecord

　　　　'採番テーブルに新しいNoで更新をする
　　　　ClsDao.UpdateID NewKey
　　　　modPub.lngNewRecID = NewKey　'Global変数に新しいID NOをセット（親画面で取得するため）
　　　　Set ClsDao = Nothing

　　　　BeforeUpdate = "[イベント プロシージャ]"
　　'　　Me.Visible = False
　　　　DoCmd.Close

　　End If
End Sub
◆B画面の保存ボタンの処理終わり

その後、呼出元のB画面を開くイベントの処理を継続し
A画面を更新し、新規入力されたレコードを選択する処理をしています。

問題は、まず１回目には、新規作成ボタンを押して新規データを登録し
A画面でその新規レコードを選択することが１回目は可能で
同じ事を２回目すると、
※実行時エラー'7951':
　RecordSetCloneプロパティに対する不適切な参照を含む式を入力しました。
というエラーが出ます。
その時の画面は、複数行あったのが一レコードだけになってしまい、
各項目のTextboxは、「#Name?」が表示されています。

デバッグボタンを押すと
以下のソースの「Set Rec = Me.RecordsetClone」で止まります。
この解決方法を教えて下さい。

◆A画面の新規作成ボタンのソースの内容開始
Private Sub cmdNewRec_Click()
　　Dim ClsDao As ClsDao
　　Dim SQL As String
　　Dim NewFm As Form
　　Dim Rec As Recordset
　　Dim NewNo As Long
　　Dim MyFm As Form
　　Dim StrRecSource As String

　　Set MyFm = Me.Form
　　 StrRecSource = Me.RecordSource

　　DoCmd.OpenForm "FXX作業記録(NewEntry_連結版)", acNormal, , , acFormAdd, acDialog

　　If modPub.lngNewRecID > 0 Then
　　　　NewNo = modPub.lngNewRecID
　　　　Me.RecordSource = StrRecSource
　　　　Me.Requery
　　　　Set Rec = Me.RecordsetClone　<===ここでエラー
　　　　Rec.FindFirst "作業記録ID = " & NewNo
　　　　If Rec.NoMatch = False Then
'　　　　　　Me.CurrentRecord = Rec.AbsolutePosition
　　　　　　DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, Rec.AbsolutePosition + 1
　　　　　　Rec.Close
　　　　　　Set Rec = Nothing
　　　　End If
　　End If
End Sub
◆A画面の新規作成ボタンのソースの内容終了

回答No.1

piroin654 · ベストアンサー

実行しているファイルの参照設定がどうなっているのか
明記されていないので、憶測でしか言えませんが。

エラーが生じるコードの変数宣言で、

Dim ClsDao As ClsDao

とありますが、これはクラスモジュールで何かDAOを
定義している、ということでしょうか。そうすると
ファイルの参照設定で、DAOはチェックされていない、
あるいはチェックされていてもDAOがADOの上位に
表示されていない、ということなのでしょうかね。

ということであれば一度、参照設定でDAOにチェックを
入れ、

＞Dim Rec As Recordset

を、

Dim Rec As DAO.Recordset

としてみてはどうですか？

ところで、もしクラスモジュールでDAOを定義しているならば
その理由は？

お礼

ご回答ありがとうございます。限られた情報でアドバイスを頂き感謝です。

それと、これは私の推測なのですが
この私の質問の原因に関して、私がついふと思いついたのですが・・・

テーブルA
フォームA帳票型→レコードソース：A
フォームB単票型→recordソース：A

1) Aの開くボタンクリック処理：Bを開く（Dialogモード→新規record入力用しか表示しない）。ここで、、処理が一時止まる。

2) Bの保存ボタン：データをコードで保存し、Bを閉じる
3) (1)の処理の継続する。
　・画面をリクエリ－
　・フォームのrecordsetでフィールドの値を検索をする
　→エラー

この場合に、(1)から(2)に進み新規入力モードでrecordを入れ保存したとき
何故か、Aの画面でも、新規入力モードを覚えているので
A.Requeryとすると
全ての項目が「?Name」となってしまい
Set Rst = me.RecordsetClone
Rst.FindFirst "項目名 = " & 値

を実行しても、Rstの中には何もないですよ・・・というエラーが発生してしまうのでしょうか？

補足

ご回答ありがとうございます。
クラスモジュールでは、頭で、private prvRs as Recordset
となっていました。
ご説明の通り、念のためDAO.Recordset
と書き直しました。
まだ、このテストは実施出来ておりませんが、後ほどしてみます。

クラスに関するご質問ですが、
共通化して、自動採番処理に使用しています。
自動採番時は、このクラスが終了するまでは、できるだけ
Recordsetはクローズしないような作りにして、もし、複数の人が使用する場合には、それに対応できるようにしようかと考えていました。

無理やりなので、もしかするとうまくいかないかもしれませんが。

OpenRecordsetでは、オプションに「dbDenyRead Or dbDenyWrite」を入れています。
これで、他の人が同じテーブルにアクセスしようとすれば、不可能になりますので。

でも同時に出来ないので、意味がないと言えば、意味がないのでしょうか・・・

回答No.2

m3_maki

この処理が邪魔しているようですが。

　　Me.RecordSource = StrRecSource

本当に必要ですか？

お礼

回答して頂きありがとうございます。現在のところ、新規入力フォームとして開かず、編集用モードでフォームを開くようにして問題がありませんので、とりあえず、ここでこの質問を閉じさせていただきます。
原因が今ひとつ分からないのですが、Workspaceの使用、未使用でも何か影響がありそうなのかと考えています。

ありがとうございました。

補足

これを消して、
Me.Requeryとしても、2回目に同じ処理を実行すると、Rst.FindFirstのところでRstがおかしいと言って叱られます。

以下、その他のソースです。
明細フォームと単票フォームは、作業記録テーブルというテーブルがレコードソースです。
主キーは、作業記録ID
採番は、採番テーブル（後述）で管理しています。

'明細フォームの新規ボタンクリック実行処理
Private Sub cmdNewRec_Click()
　　Dim ClsDao As ClsDao
　　Dim SQL As String
　　Dim NewFm As Form
　　Dim Rec As Recordset
　　Dim NewNo As Long
　　Dim MyFm As Form
　　Dim StrRecSource As String

　　Set MyFm = Me.Form
　　 StrRecSource = Me.RecordSource

　　modPub.flgBackFromNewEntryWindow = True
　　modPub.pubStrCallFormName = Me.name
　　DoCmd.OpenForm "FXX作業記録(NewEntry_連結版)", acNormal, , , acFormEdit, acDialog
　　'↑ここで、保存ボタン押すまで、処理が止まる
　　'↓新規入力したレコードのID番号を取得し、それで自画面の検索をし、
　　'　そのレコードを選択する処理
　　If modPub.lngNewRecID > 0 Then
　　　　NewNo = modPub.lngNewRecID
　　　　Me.Requery
　　　　Set Rec = Me.RecordsetClone
　　　　Rec.FindFirst "作業記録ID = " & NewNo '<---　2回目にこの処理を実行すると、ここでエラーに成る。
　　　　If Rec.NoMatch = False Then
'　　　　　　Me.CurrentRecord = Rec.AbsolutePosition
　　　　　　DoCmd.GoToRecord acDataForm, Me.name, acGoTo, Rec.AbsolutePosition + 1
　　　　　　Set Rec = Nothing

　　　　End If
　　End If
End Sub

テーブル情報
【T95ID管理表】
1)主キー
2)主キーフィールド名
3)final_value
4)新規作成日時
5)更新日時
6)削除日時

ここでは、(2)に、「作業記録ID」がセットされている。

上の新規ボタンで開く単票フォームのフッターにある保存ボタンの処理
Private Sub cmd保存_Click()
　　'保存処理
　　Dim NewKey As Long
　　Dim SQL As String

　　If Me.Dirty = True Then

　　　　Ret = MsgBox("入力したデータを保存しますか。", vbQuestion + vbOKCancel)
　　　　If Ret = vbCancel Then
　　　　　　cmd取消_Click
　　　　　　GoTo exitH
　　　　End If
　　　　Set Me.ClsDao_ = New ClsDao
　　　　SQL = "Select final_value, [更新日時] from T95ID管理表 "
　　　　SQL = SQL & "where "
　　　　SQL = SQL & " ID_Name = '作業記録ID';"

　　　　'採番テーブルに新しいNoで更新をする
　　　　NewKey = ClsDao.UpdateID(SQL)

　　　　Me.作業記録ID.Value = NewKey
　　　　Me.BeforeUpdate = ""
　　　　DoCmd.RunCommand acCmdSaveRecord

　　　　modPub.lngNewRecID = NewKey
　　　　Set ClsDao = Nothing
　　　　BeforeUpdate = "[イベント プロシージャ]"
　　　　DoCmd.Close acForm, Me.name
　　End If

exitH:
　　　　BeforeUpdate = "[イベント プロシージャ]"
　　Exit Sub

EditErr:
　　MsgBox Err.Number & "(" & Err.Description & ")"
　　Resume exitH

End Sub

'ClsDAOの処理、採番テーブルからIDを取得する
Public Function UpdateID(strSQL As String) As Long

　　Dim TempKeyValue As Long

　　UpdateID = -1

　　On Error GoTo NKV_Err
　　' 90ms から 150ms の範囲でランダムに遅延時間を設定しする
　　DBEngine.SetOption dbLockDelay, 90 + Rnd * 60

　　If Me.objWS Is Nothing Then
　　 Set Me.objWS = DBEngine(0)
　　End If

　　'objDBは、クラスのInitiateでSetする。

　　On Error GoTo errOpenRec
　　Set Me.objREC = Me.objDb.OpenRecordset(strSQL, dbOpenDynaset, _
　　　　　　　　dbDenyRead Or dbDenyWrite)

　　' リード キャッシュをリフレッシュ
　　DBEngine.Idle dbRefreshCache

　　TempKeyValue = Me.objREC.Fields("final_value").Value
　　NewNo = TempKeyValue + 1

　　On Error GoTo CommitTransErr

　　Me.objWS.BeginTrans
　　Me.objREC.Edit
　　Me.objREC.Fields("final_value").Value = NewNo '
　　Me.objREC.Fields("更新日時").Value = Format(Now(), "yyyy/mm/dd hh:MM:ss")
　　Me.objREC.Update
　　' 遅延書き込みキャッシュをフラッシュ
　　Me.objWS.CommitTrans dbForceOSFlush

　　Me.objREC.Close
　　Me.objDB.Close
　　Me.objWS.Close

　　UpdateID = NewNo

　　Exit Function

NKV_Abort:
　　On Error Resume Next
　　If objREC Is Nothing Then
　　　　Me.objREC.Close
　　End If
　　If objDB Is Nothing then
　　 Me.objDB.Close
　　end if
　　If Me.objWS Is Nothing Then
　　　　Me.objWS.Close
　　End If

　　Exit Function

NKV_Err:
'　　On Error Resume Next

　　MsgBox Err.Number & "(" & Err.Description & ") in GetMaxKey_noUpdate procedure"
　　Resume NKV_Abort

errOpenRec:
　　MsgBox Err.Number & "([OpenRecordsetエラー]" & Err.Description & ") in GetMaxKey_noUpdate procedure"
　　Resume NKV_Abort

CommitTransErr:
　　On Error Resume Next
　　Me.objWS.Rollback
　　GoTo NKV_Abort

End Function