How to Insert a Variable Number of Records into an Access Table Based on a Fields Value

Question

I have an Access Table with the following columns: WeeklyID(PrimaryKey), CampaignID(Foreignkey), WeekEnded(Date Field), Duration(Number Field).

I want to automatically a

Answer 1

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