这是一种方法。请注意，我计划的场景是有人在添加记录后更改持续时间。
Option Compare Database
Option Explicit
Dim dbs As DAO.Database
Dim rs As DAO.recordSet
Dim rsOT As DAO.recordSet
Function Create_New_Rows()
Dim strsql As String
Dim i As Integer
Dim iAdd As Integer
Dim iDuration As Integer
Dim lCampaignID As Long
On Error GoTo Error_trap
Set dbs = CurrentDb
strsql = "SELECT Count(Campaign.WeeklyID) AS NbrRecs, First(Campaign.Duration) AS Duration, Campaign.CampaignID " & _
"FROM Campaign " & _
"GROUP BY Campaign.CampaignID;"
Set rs = dbs.OpenRecordset(strsql)
Set rsOT = dbs.OpenRecordset("Campaign")
If rs.EOF Then
Msg@R_59_2419@ "No records found!", vbOKOnly + vbCritical, "No Records"
GoTo Exit_Code
Else
rs.MoveFirst
End If
do while Not rs.EOF
Debug.Print "Campaign: " & rs!CampaignID & vbTab & "Duration: " & rs!Duration & vbTab & "# Recs: " & rs!NbrRecs
iDuration = rs!Duration
lCampaignID = rs!CampaignID
' Check if already have correct number of records for this ID
If iDuration = rs!NbrRecs Then
' Do nothing... counts are good
ElseIf iDuration < rs!NbrRecs Then
Msg@R_59_2419@ "Add code to resolve too many records for Campaign: " & lCampaignID & vbCrLf & _
"Duration: " & iDuration & vbCrLf & _
"Records: " & rs!NbrRecs, vbOKOnly + vbCritical, "Too many records already!"
Else
' Finally, Duration is less than existing records... time to add...
iAdd = iDuration - rs!NbrRecs
Do
If iAdd > 0 Then
' Add new record
Add_Records lCampaignID
iAdd = iAdd - 1
Else
Exit Do
End If
Loop
End If
rs.MoveNext
Loop
Exit_Code:
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
If Not rsOT Is Nothing Then
rsOT.Close
Set rsOT = Nothing
End If
dbs.Close
Set dbs = Nothing
Msg@R_59_2419@ "Finished"
Exit Function
Error_trap:
Debug.Print Err.Number & vbTab & Err.Description & vbCrLf & "In: Create_New_Rows"
Msg@R_59_2419@ Err.Number & vbTab & Err.Description & vbCrLf & "In: Create_New_Rows"
Resume Exit_Code
Resume
End Function
Function Add_Records(lCampID As Long)
With rsOT
.AddNew
!CampaignID = lCampID
' Add code if you want to populate other fields...
.Update
'Debug.Print "Added rec for CampaingID: " & lCampID
End With
End Function
602392714
清零编程群