ほぼ動作するようになりました。もう 1 組の人の目が必要だと思います。問題は単純なプログラミング構造の問題だと思います。ループが多すぎるか、レコードセットを間違った順序で開いたり閉じたりしている可能性があります。
ある DAO レコードセットのレコードに含まれるすべての添付ファイルを、別の DAO レコードセットの対応するレコードにコピーしようとしています。両方のレコードセットは同じテーブルからデータを取得しています。最初のレコードセット (rstOld) には、昨年の日付値を持つレコードが含まれており、これらのレコードには任意の数の添付ファイルを含めることができます。2 番目のレコードセット (rstNew) には、今年の日付値を持つレコードが含まれており、これらのレコードには添付ファイルは含まれていません。
これを実現するには、rstNew の各レコードをループします。rstNew の各レコードについて、Name フィールドの値を収集し、2 番目のループを開始します。2 番目のループでは、一致する Name フィールドを持つ rstOld のレコードを検索します。そこから、rstOld のレコードから rstNew のレコードにすべての添付ファイルをコピーするだけです。
奇妙なことに、rstNew で一致が見つかった最初のレコードでは正常に動作します。その後、後続のレコードでは動作しなくなります。
これまでのコードは次のとおりです。
Dim db As Database
Dim strOldSQL As String
Dim rstOld As DAO.Recordset2
Dim strNewSQL As String
Dim rstNew As DAO.Recordset2
Dim rstOldAttachments As DAO.Recordset2
Dim rstNewAttachments As DAO.Recordset2
Dim strCurrentSiteName As String
Dim strOldSiteName As String
Set db = CurrentDb()
'First let's open a recordset that contains all of the records from this year.
strNewSQL = "SELECT tblAuditForms.SiteName, tblAuditForms.Attachments, tblAuditForms.AuditYear FROM tblAuditForms WHERE AuditYear = #" & Format(cboMyDate, "mm/dd/yyyy") & "# ORDER By tblAuditForms.SiteName;"
Set rstNew = db.OpenRecordset(strNewSQL)
rstNew.MoveFirst
rstNew.Edit
Do While Not rstNew.EOF 'Now we need to loop through these records.
strCurrentSiteName = rstNew.Fields("SiteName").Value 'Get the name of the site for the current record that we're on. We'll use this to compare with the sites in the previous audit.
'Now let's open a recordset that contains all records from the previous audit.
strOldSQL = "SELECT tblAuditForms.SiteName, tblAuditForms.Attachments, Year([AuditYear]) FROM tblAuditForms WHERE Year([AuditYear]) = " & Me.cboPreviousDate & " ORDER BY tblAuditForms.SiteName;"
Set rstOld = db.OpenRecordset(strOldSQL)
rstOld.MoveFirst
Do While Not rstOld.EOF 'Loop through each of the records from the previous audit until we find a record that matches the current site name.
strOldSiteName = rstOld.Fields("SiteName").Value
If strCurrentSiteName = strOldSiteName Then 'If this is true, then we've found a record from the previous audit that matches the one from our current audit.
'Now it's just a matter of copying the attachments from the old record into the new one. Working with attachments is annoying though.
'This next block should loop through the attachments (if any) in the old record and copy them into the new record.
Set rstOldAttachments = rstOld.Fields("Attachments").Value
rstOldAttachments.MoveFirst
Set rstNewAttachments = rstNew.Fields("Attachments").Value
Do While Not rstOldAttachments.EOF
rstNewAttachments.AddNew
rstNewAttachments.Fields("FileData").Value = rstOldAttachments.Fields("FileData").Value
rstNewAttachments.Fields("FileName").Value = rstOldAttachments.Fields("FileName").Value
rstNewAttachments.Fields("FileType").Value = rstOldAttachments.Fields("FileType").Value
rstNewAttachments.Update
rstOldAttachments.MoveNext
Loop
'Now that we've found the site from the previous audit and copied its attachments into the new record we can close the old recordset and move onto the next site in the current audit.
rstOldAttachments.Close
rstNewAttachments.Close
Exit Do
End If
rstOld.MoveNext
Loop
rstOld.Close
rstNew.Update
rstNew.MoveNext
Loop
'If we've gotten this far then we've looped through all of the new records that we just created from the weekly staffing workbook.
rstNew.Close
前に述べたように、このコードは rstNew レコードセットの最初のループでは機能しますが、それ以降のループでは機能しません。ループを早く終了しすぎているのでしょうか。それとも、レコードセットを早く閉じすぎているのでしょうか。
答え1
分かりました! 近かったことは分かっていました。recordset.update (または私の場合は rstNew.update) ステートメントを実行すると、レコードセットの editmode プロパティが 0 に戻ることがわかりました。これで、最初のループでは添付ファイルのコピーが成功するものの、それ以降のループでは失敗する理由が説明できます。つまり、"rstNew.Edit" ステートメントを "Set rstNewAttachments = rstNew.Fields("Attachments").Value" 行のすぐ上に移動するだけで済みました。
新しいコードは次のようになります。
Dim db As Database
Dim strOldSQL As String
Dim rstOld As DAO.Recordset2
Dim strNewSQL As String
Dim rstNew As DAO.Recordset2
Dim rstOldAttachments As DAO.Recordset2
Dim rstNewAttachments As DAO.Recordset2
Dim strCurrentSiteName As String
Dim strOldSiteName As String
Set db = CurrentDb()
'First let's open a recordset that contains all of the records from this year.
strNewSQL = "SELECT tblAuditForms.SiteName, tblAuditForms.Attachments, tblAuditForms.AuditYear FROM tblAuditForms WHERE AuditYear = #" & Format(cboMyDate, "mm/dd/yyyy") & "# ORDER By tblAuditForms.SiteName;"
Set rstNew = db.OpenRecordset(strNewSQL)
rstNew.MoveFirst
Do While Not rstNew.EOF 'Now we need to loop through these records.
strCurrentSiteName = rstNew.Fields("SiteName").Value 'Get the name of the site for the current record that we're on. We'll use this to compare with the sites in the previous audit.
'Now let's open a recordset that contains all records from the previous audit.
strOldSQL = "SELECT tblAuditForms.SiteName, tblAuditForms.Attachments, Year([AuditYear]) FROM tblAuditForms WHERE Year([AuditYear]) = " & Me.cboPreviousDate & " ORDER BY tblAuditForms.SiteName;"
Set rstOld = db.OpenRecordset(strOldSQL)
rstOld.MoveFirst
Do While Not rstOld.EOF 'Loop through each of the records from the previous audit until we find a record that matches the current site name.
strOldSiteName = rstOld.Fields("SiteName").Value
If strCurrentSiteName = strOldSiteName Then 'If this is true, then we've found a record from the previous audit that matches the one from our current audit.
'Now it's just a matter of copying the attachments from the old record into the new one. Working with attachments is annoying though.
'This next block should loop through the attachments (if any) in the old record and copy them into the new record.
Set rstOldAttachments = rstOld.Fields("Attachments").Value
rstOldAttachments.MoveFirst
rstNew.Edit
Set rstNewAttachments = rstNew.Fields("Attachments").Value
Do While Not rstOldAttachments.EOF
rstNewAttachments.AddNew
rstNewAttachments.Fields("FileData").Value = rstOldAttachments.Fields("FileData").Value
rstNewAttachments.Fields("FileName").Value = rstOldAttachments.Fields("FileName").Value
rstNewAttachments.Fields("FileType").Value = rstOldAttachments.Fields("FileType").Value
rstNewAttachments.Update
rstOldAttachments.MoveNext
Loop
'Now that we've found the site from the previous audit and copied its attachments into the new record we can close the old recordset and move onto the next site in the current audit.
rstOldAttachments.Close
rstNewAttachments.Close
Exit Do
End If
rstOld.MoveNext
Loop
rstOld.Close
rstNew.Update
rstNew.MoveNext
Loop
'If we've gotten this far then we've looped through all of the new records that we just created from the weekly staffing workbook.
rstNew.Close