Question

一般使用Access 2010和相对较新的Access。为简单起见，我有以下两个表：

Tbl 1：Employee_Info （字段：Employee_ID（主键），Employee_Name和＆Employee_Status（活动，非活动，称为））

Tbl 2：Monthly_Sales （字段：月/年，销售和＆amp; Employee_ID（外键））

我们团队的每个月都必须为所有活跃员工输入月度销售额，我想设计一个表格，其中所有活跃员工都显示为记录，而进行数据输入的人员只需输入月份和年份和销售。类似的东西：

日期：用户在此输入日期一次并预先填写以下所有记录

第1列： Employee_ID ：显示所有有效的员工ID

第2列：销售：这些字段为空白，用户输入每月销售额。

我已经浏览了整个互联网，并且无法找到解决此问题的方法。我不认为它就像使用追加查询一样简单，但我再次相对较新。在此先感谢您的帮助。

Answer 1

您可以使用以下代码添加一个月的记录...只需更改表/字段名称以匹配您的数据库。您的表设计应该防止重复的Employee_ID和YearMonth组合。如果是这样，如果有人在同一个月运行代码两次，代码将忽略错误。如果没有，您需要确保没有添加重复的方法。

Option Compare Database
Option Explicit

Function Create_New_Rows()
Dim strSQL          As String
Dim i               As Integer
Dim iAdd            As Integer
Dim iDuration       As Integer
Dim lCampaignID     As Long
Dim dbs             As DAO.Database
Dim rsIN            As DAO.recordSet
Dim rsOT            As DAO.recordSet
Dim DateRange       As Date
Dim dStart          As Date
Dim dEnd            As Date
Dim InDate          As String

    On Error GoTo Error_Trap

    InDate = InputBox("Input the Year and Month to process. i.e. 201610", "Enter YYYYMM", _
        Format(YEAR(Date) & month(Date), "000000"))

    ' Add some validation to insure they enter a proper month and year!!


    dStart = Mid(InDate, 5, 2) & "/01/" & left(InDate, 4)
    dEnd = DateSerial(YEAR(dStart), month(dStart) + 1, 0)

    Set dbs = CurrentDb

    strSQL = "SELECT Employee_ID, Employee_Status " & _
                "FROM Table1 " & _
                "Where Employee_Status = 'active';"

    Set rsIN = dbs.OpenRecordset(strSQL)
    Set rsOT = dbs.OpenRecordset("Table2")

    If rsIN.EOF Then
        MsgBox "No Active Employees found!", vbOKOnly + vbCritical, "No Records"
        GoTo Exit_Code
    Else
        rsIN.MoveFirst
    End If

    Do While Not rsIN.EOF
        DateRange = dStart
        Do
            With rsOT
                .AddNew
                !Employee_ID = rsIN!Employee_ID
                !MonthYear = Format(YEAR(DateRange) & month(DateRange), "000000")
                .Update
            End With
            DateRange = DateAdd("d", 1, DateRange)
            If DateRange > dEnd Then
                Exit Do
            End If
        Loop

        rsIN.MoveNext
    Loop

Exit_Code:
    If Not rsIN Is Nothing Then
        rsIN.Close
        Set rsIN = 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"
    ' Ignore if duplicate record
    If Err.Number = 3022 Then
        Resume Next
    End If

    MsgBox Err.Number & vbTab & Err.Description & vbCrLf & "In: Create_New_Rows"
    Resume Exit_Code
    Resume
End Function

使用所有活动员工访问2010预填充月度销售表单记录

1 个答案: