Question

我有一个包含以下列的访问表：WeeklyID（PrimaryKey），CampaignID（外键），WeekEnded（日期字段），持续时间（数字字段）。

我想自动将X个记录添加到表中，其中X是存储在“持续时间”字段中的数字。我希望添加的记录与原始记录具有相同的CampaignID。因此，当具有一个特定CampaignID的记录的计数等于持续时间数时，将满足自动化过程。

如果有人能就如何做到这一点提供帮助，我们将不胜感激。如果您需要任何进一步的信息，请询问！

Answer 1

您可以修改此功能以将lngCount作为固定值：

Public Sub CopyEmptyRecords()

  Dim rstSource   As DAO.Recordset
  Dim rstInsert   As DAO.Recordset
  Dim fld         As DAO.Field
  Dim strSQL      As String
  Dim lngLoop     As Long
  Dim lngCount    As Long
  Dim booCopy     As Boolean

  strSQL = "SELECT * FROM tblStats"
  Set rstSource = CurrentDb.OpenRecordset(strSQL)

  strSQL = "SELECT TOP 1 * FROM tblStatsNull"
  Set rstInsert = CurrentDb.OpenRecordset(strSQL)

  With rstSource
    .MoveLast
    .MoveFirst
    lngCount = .RecordCount            ' Set to fixed value of 7.
    For lngLoop = 1 To lngCount
      With rstInsert
        booCopy = False
        .AddNew
          For Each fld In rstSource.Fields
            With fld
              If .Attributes And dbAutoIncrField Then
                ' Skip Autonumber or GUID field.
              Else
                ' Copy field content.
                rstInsert.Fields(.Name).Value = .Value
                If Len(Trim(Nz(.Value, vbNullString))) = 0 Then
                  booCopy = True
                End If
              End If
            End With
          Next
        If booCopy = True Then
          .Update
        Else
          .CancelUpdate
        End If
      End With
      .MoveNext
    Next
    rstInsert.Close
    .Close
  End With

  Set rstInsert = Nothing
  Set rstSource = Nothing

End Sub

Answer 2

这是一种方法。请注意，我计划在有人改变持续时间的情况下 - 添加记录后。

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

如何基于字段值将可变数量的记录插入到访问表中

2 个答案: