I have an Access Table with the following columns: WeeklyID(PrimaryKey), CampaignID(Foreignkey), WeekEnded(Date Field), Duration(Number Field).
I want to automatically add X number of records to the table, where X is the number stored in the Duration field. I want the added records to have the same CampaignID as the original record. So the automated process would be satisfied when the count of the records with one specific CampaignID was equal to the Duration number.
If anyone could provide assistance on how to accomplish this, it would be much appreciated. If you need any further info, please ask!
Here's one way to do it. Note that I planned for a scenario where someone changes the duration -- after adding the records.
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 MsgBox "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 MsgBox "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 MsgBox "Finished" Exit Function Error_trap: Debug.Print Err.Number & vbTab & Err.Description & vbCrLf & "In: Create_New_Rows" MsgBox 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