触发和处理现场事件和记录事件的类模块

时间:2018-08-23 22:05:23

标签: ms-access access-vba

我正在为我们公司建立数据库。他们希望此数据库要做的一件大事是根据更改的字段和新创建的记录创建提醒和电子邮件。例如,当用户在“ First_Meeting”字段中输入日期时,应触发一个事件,该事件将在Outlook日历上创建3个提醒。作为第二个示例,在“合同”表中创建新记录时,应触发一个事件以在Outlook日历和2个Outlook电子邮件中创建2个提醒。

我有逻辑来完成所有这些工作,但是我正在尝试找出处理事件的最佳方法。重要的是,无论First_Meeting字段的更新形式如何,触发都将发生。如果执行表单字段事件,则必须确保将代码添加到包含该字段的所有表单中。我想知道是否有一种方法可以使用Class模块来执行此操作,以便可以在表字段或记录上触发事件。我还没有做过OO,但是几年前就对它进行了研究,所以我对它的工作方式有一个非常模糊的理解。抱歉,我的问题不是很具体,但是我不想在OO和类模块的学习曲线上花费很多时间,只是为了发现我想做的事情无法完成。另一方面,如果我可以在一个地方完成所有这些操作,而不必担心以后再进行,那么花任何时间都值得!

我的问题是:我可以在表字段上创建一个类,该类会在该字段被编辑时触发事件吗?并且我可以在表(或表记录)上创建一个类,该类在任何记录插入表时都会触发吗?实现此目的的逻辑是什么?

我正在使用一个表来保存将基于更新的字段或创建的记录创建的所有项目。

我正在使用Access2016。在此先感谢您为我提供的任何帮助!!! 金

这是我当前用于First_Meeting事件的事件代码:

'This code calls a form to select the reminders to create

Private Sub First_Meeting_AfterUpdate()
Dim strSql As String
Dim strWhere As String
Dim strOrderBy As String
Dim intRecordCount As Integer

'Save any changes to data before selecting appointments to set
If Me.Dirty Then
    Me.Dirty = False
End If

'The "Where" keyword is not included here so it can be used for the DCount function
strWhere = " [Appt Defaults].[Field Name]='First Meeting Date'"
strOrderBy = " ORDER BY [Appt Defaults].[Order for List], [Appt Defaults Child].[Date Offset]"

strSql = "SELECT Count([Appt Defaults Child].ID) AS CountOfID " & _
    "FROM [Appt Defaults] INNER JOIN [Appt Defaults Child] ON [Appt Defaults].ID = [Appt Defaults Child].ReminderID"

intRecordCount = DCount("ReminderID", "qDefaultAppts", strWhere)

If intRecordCount > 0 Then

    DoCmd.SetWarnings False
    'Delete records from the Temp table
    DoCmd.RunSQL "Delete * From TempApptToSelect"

    'Add the "Where" keyword to be used in the query
    strWhere = "Where " & strWhere
    strSql = CurrentDb.QueryDefs("[qAddApptsToTemp-MinusCriteria]").SQL
    'The ";" symbol is added to the end of the query so it needs to be stripped off
    strSql = Replace(strSql, ";", "")
    strSql = strSql & strWhere & strOrderBy
    DoCmd.RunSQL strSql
    'Flag all of the events in the Temp Table as Selected
    DoCmd.RunSQL "UPDATE TempApptToSelect SET TempApptToSelect.IsSelected = -1"
    DoCmd.SetWarnings True

    DoCmd.OpenForm "Reminders - Select Main", , , , , , OpenArgs:=Me.Name

End If
End Sub

'此代码来自选择提醒的表单

Private Sub cmdCreateReminders_Click()
' This Routine copies all of the selected default records from the Appt Defaults tables and copies them to the Reminder Tables
'
Dim rstReminderDefaults As Recordset
Dim rstReminders As Recordset
Dim nID As Integer
Dim dtStartDate As Date
Dim dtStartTime As Date
Dim dtEndTime As Date
Dim strProjectName As String
Dim strProjectAddress As String
Dim strApptArea As String
Dim iCount As Integer

' The calling form has the info needed to set the values for the reminders
' The form "frmCalendarReminders" is generic and will be on all forms that need to set reminders

txtCallingForm = Me.OpenArgs()

'The form recordset is a temp query created from the calling routine which determines the record filter
Set rstReminders = Forms(txtCallingForm)!frmCalendarReminders.Form.RecordsetClone
Set rstReminderDefaults = CurrentDb.OpenRecordset("qApptsToSet")

nID = Forms(txtCallingForm)!ID

strApptArea = Left(rstReminderDefaults![Appt Area], 8)

Select Case strApptArea
    Case "Projects"

        strProjectName = Forms(txtCallingForm)!txtProjectName
        strProjectAddress = Forms(txtCallingForm)!txtProjectAddressLine & vbCrLf & Forms(txtCallingForm)!txtProjectCityLine

        With rstReminderDefaults
            Do While Not .EOF
                'If this reminder has not already been created
                If DCount("ID", "PR_Child-Reminders", "[Project ID] =" & Forms(txtCallingForm)![ID] & " And [ReminderChildID]= " & ![ReminderChildID]) = 0 Then
                    rstReminders.AddNew
                    'Initialize fields with values from defaults
                    rstReminders![ReminderChildID] = ![ReminderChildID]
                    rstReminders![Project ID] = nID
                    rstReminders![Reminder Type] = ![Outlook Item Type]
                    rstReminders![Reminder Subject] = ![Subject]
                    rstReminders![Reminder Text] = ![Body]
                    rstReminders![Invited] = ![Invite]
                    rstReminders![Email CC] = ![Email CC]
                    rstReminders!Calendar = !CalendarID
                    rstReminders!Color = !ColorID
                    Select Case ![Appt Type]
        .
        .
                        Case "First Meeting"
                            If Not IsNull(Forms(txtCallingForm)!dtFirstMeeting) Then
                                'dtStartDate will be used later to fill in Placeholder field in Subject and Body of Calendar and Email Items
                                 dtStartDate = Forms(txtCallingForm)!dtFirstMeeting
                                 rstReminders![Reminder Date] = dtStartDate + ![Date Offset]
                            Else
                                'Quit working on this reminder since it has invalid conditions
                                MsgBox "No date has been set for the " & ![Appt Type] & " so reminders cannot be created"
                                rstReminders.CancelUpdate
                                GoTo NextLoop
                            End If
                    End Select
                        .
          rstReminders.Update
                    CreateOrSend (txtCallingForm)
           .            
NextLoop:
                .MoveNext
            Loop
        End With
End Select
DoCmd.Close

End Sub

‘此代码用于创建提醒或电子邮件

Sub CreateOrSend(CallingForm)
Dim bError As Boolean
Dim strName As String
Dim strSubject As String
Dim strBody As String
Dim strType As String
Dim strAttendees As String
Dim strCC As String
Dim strColorCategory As String
Dim dtStartDate As Date
Dim dtEndDate As Date
Dim strReminderText As String
Dim strLocation As String
Dim decDuration As Single

With Forms(CallingForm)!frmCalendarReminders.Form
    'bError will be used to determine if the calendar item is created without error
    bError = False
    If !cmbReminderType = "Calendar" Then
        strName = !cmbCalendar.Column(2)
        strSubject = !txtReminderSubject
        If Not IsNull(!txtReminderNote) Then
            strBody = !txtReminderNote
        Else
            strBody = ""
        End If
        If Not IsNull(!txtInvite) Then
            strAttendees = !txtInvite
        Else
            strAttendees = ""
        End If
        strColorCategory = !cmbColor.Column(1)
        dtStartDate = !dtStartDate & " " & !dtStartTime
        dtEndDate = !dtEndDate & " " & !dtEndTime
        If Not IsNull(!txtReminderNote) Then
            strReminderText = !txtReminderNote
        Else
            strReminderText = ""
        End If
        strLocation = IIf(IsNull(.Parent!txtProjectAddressLine), ".", .Parent!txtProjectAddressLine & ", " & .Parent![Project City])
        ' Parameter Order: strName, strSubject, strBody, strAttendees, strColorCategory, dtStartDate, dtEndDate, strReminderText Optional:  strLocation, decDuration
        Call CreateCalendarAppt(bError, strName, strSubject, strBody, strAttendees, strColorCategory, dtStartDate, dtEndDate, strReminderText, strLocation)

        If bError = False Then
            !dtCreatedItem = Date
        Else
            MsgBox "***** YOUR APPOINTMENT FAILED ******"
        End If
    Else
        If Not IsNull(!txtReminderNote) Then
            strBody = !txtReminderNote
        Else
            strBody = ""
        End If
        strSubject = !txtReminderSubject
        If Not IsNull(!txtInvite) Then
            strAttendees = !txtInvite
            strCC = !txtEmailCC
            SendCustomHTMLMessages strAttendees, strCC, strSubject, strBody
            !dtCreatedItem = Date
        Else
            MsgBox "There were no email addresses to send this message to"
        End If

    End If
End With
End Sub

2 个答案:

答案 0 :(得分:0)

不幸的是,无法完成您想要的事情。尽管Access具有“数据宏”之类的内容,但是无法从那里运行VBA过程。

但是不要害怕在表单中使用事件过程。您不必将所有现有代码复制到每个事件过程。您可以将现有代码放在标准模块中,然后在表单中使用非常短的事件过程在标准模块中调用这些过程。这仍然使主要例程易于维护。

答案 1 :(得分:0)

我不同意沃尔夫冈。

我当然建议使用img_orig = img_orig * 255 img_orig = img_orig.astype('uint8') img_orig = PIL.Image.fromarray(img_orig) 作为后端,但是使用Access和Data-Macros,您可以更新基础表中的时间戳记字段,该字段随每次更改而更新。

此外,每隔x分钟在服务器上运行一个脚本(我不知道您需要多少时间间隔),并检查自上次运行脚本以来是否更新了行(比较时间戳记)。.

如果为true,则运行任务。

如果这不是一种选择,我们可以讨论使用类和MSSQL Server拦截表单事件,但这将需要更多的精力来实现。