TryingtoLearn TryingtoLearn - 6 months ago 11
SQL Question

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

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!

Answer

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