I have a module on my main form that when it is open, it checks to see if there is anyone in the database that has a birthday in the next 30 days from today. The problem is, the form does not completely open before the birthday check triggers and the message pops up stating, “You have Birthday cards to send.” Once I click okay, the message box closes and the rest of the form displays. My questions are: 1) is my code causing the problem or 2) is there a way to hold the check for birth dates until the form completely loads?
As always, suggestions are welcome.
As always, suggestions are welcome.
Code:
Option Compare Database
Option Explicit
Dim mvarPostalCode
Private Sub Form_Resize()
DoCmd.Maximize
End Sub
Private Sub Form_Open(Cancel As Integer)
Me.Filter = ""
Me.FilterOn = True
'**********************************************************
'
'Check for Birthdates within next 30 days from today's date
'
'**********************************************************
On Error GoTo Err_Form_Open
Dim rstItems As DAO.Recordset
Dim db As DAO.Database
Dim lngCount As Long
Set db = CurrentDb
Set rstItems = db.OpenRecordset("qryNextBirthDay", dbOpenSnapshot)
lngCount = rstItems.RecordCount
If lngCount > 0 Then
MsgBox "You have Birthday cards to send"
End If
Exit_Form_Open:
rstItems.Close
Set rstItems = Nothing
Set db = Nothing
Exit Sub
Err_Form_Open:
Select Case Err
Case Else
MsgBox Err.Description
Resume Exit_Form_Open
End Select
End Sub
'***********************************************************
' LastName_FILTERS_AfterUpdate *
'***********************************************************
Private Sub LastName_FILTERS_AfterUpdate()
On Error GoTo LastName_FILTERS_AfterUpdate_Err
' Attached to A-Z and ALL buttons on the Falcon form.
If ([LastName FILTERS] = 1) Then
' Filter for LastNames that start with A.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""A*"""
End If
If ([LastName FILTERS] = 2) Then
' Filter for LastNames that start with B.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""B*"""
End If
If ([LastName FILTERS] = 3) Then
' Filter for LastNames that start with C.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""C*"""
End If
If ([LastName FILTERS] = 4) Then
' Filter for LastNames that start with D.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""D*"""
End If
If ([LastName FILTERS] = 5) Then
' Filter for LastNames that start with E.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""E*"""
End If
If ([LastName FILTERS] = 6) Then
' Filter for LastNames that start with F.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""F*"""
End If
If ([LastName FILTERS] = 7) Then
' Filter for LastNames that start with G.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""G*"""
End If
If ([LastName FILTERS] = 8) Then
' Filter for LastNames that start with H.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""H*"""
End If
If ([LastName FILTERS] = 9) Then
' Filter for LastNames that start with I.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""I*"""
End If
If ([LastName FILTERS] = 10) Then
' Filter for LastNames that start with J.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""J*"""
End If
If ([LastName FILTERS] = 11) Then
' Filter for LastNames that start with K.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""K*"""
End If
If ([LastName FILTERS] = 12) Then
' Filter for LastNames that start with L.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""L*"""
End If
If ([LastName FILTERS] = 13) Then
' Filter for LastNames that start with M.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""M*"""
End If
If ([LastName FILTERS] = 14) Then
' Filter for LastNames that start with N.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""N*"""
End If
If ([LastName FILTERS] = 15) Then
' Filter for LastNames that start with O.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""O*"""
End If
If ([LastName FILTERS] = 16) Then
' Filter for LastNames that start with P.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""P*"""
End If
If ([LastName FILTERS] = 17) Then
' Filter for LastNames that start with Q.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""Q*"""
End If
If ([LastName FILTERS] = 18) Then
' Filter for LastNames that start with R.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""R*"""
End If
If ([LastName FILTERS] = 19) Then
' Filter for LastNames that start with S.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""S*"""
End If
If ([LastName FILTERS] = 20) Then
' Filter for LastNames that start with T.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""T*"""
End If
If ([LastName FILTERS] = 21) Then
' Filter for LastNames that start with U.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""U*"""
End If
If ([LastName FILTERS] = 22) Then
' Filter for LastNames that start with V.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""V*"""
End If
If ([LastName FILTERS] = 23) Then
' Filter for LastNames that start with W.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""W*"""
End If
If ([LastName FILTERS] = 24) Then
' Filter for LastNames that start with X.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""X*"""
End If
If ([LastName FILTERS] = 25) Then
' Filter for LastNames that start with Y.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""Y*"""
End If
If ([LastName FILTERS] = 26) Then
' Filter for LastNames that start with Z.
DoCmd.ApplyFilter "LASTSORT", "[LastName] Like ""Z*"""
End If
If ([LastName FILTERS] = 27) Then
' Show all Records
DoCmd.ShowAllRecords
End If
LastName_FILTERS_AfterUpdate_Exit:
Exit Sub
LastName_FILTERS_AfterUpdate_Err:
MsgBox Error$
Resume LastName_FILTERS_AfterUpdate_Exit
End Sub
'***********************************************************
' THIS CODE TAKES THE ZIP CODE IN THE MASTER FORM AND DETERMINS IF IT IS *
' 5 OR 9 NUMBERS THEN FORMATS THE ZIP CODE CORRETLY *
'***********************************************************
Private Sub PostalCode_AfterUpdate()
If IsEmpty(mvarPostalCode) Then Exit Sub
If Len(mvarPostalCode) = 6 Then
Screen.ActiveControl = Left(mvarPostalCode, Len(mvarPostalCode) - 1)
Else
Screen.ActiveControl = Format(mvarPostalCode, "@@@@@-@@@@")
End If
mvarPostalCode = Empty
End Sub
Private Sub PostalCode_BeforeUpdate(Cancel As Integer)
Dim ctlPostalCode As Control
Dim strTitle As String
Dim strMsg As String
Const cYesNoButtons = 4
Const cNoChosen = 7
mvarPostalCode = Empty
Set ctlPostalCode = Screen.ActiveControl
If ctlPostalCode Like "#####-####" Or ctlPostalCode Like "#####" Then
Exit Sub
ElseIf ctlPostalCode Like "#########" Or ctlPostalCode Like "#####-" Then
mvarPostalCode = ctlPostalCode
Else
strTitle = "Not a ZIP Code."
strMsg = "Save as entered?"
If MsgBox(strMsg, cYesNoButtons, strTitle) = cNoChosen Then
Cancel = True
End If
End If
End Sub
Private Sub Form_AfterUpdate()
On Error GoTo ErrorHandler
Dim db As Database
Dim strSQL As String
Dim curr_rec As String
Dim MyDate As String
MyDate = Date
' Sets the current record so that after DoCmd.Requery the same record appears
curr_rec = Me.CurrentRecord
If (IsNull(DLookup("[AddressID]", "tblDependents", "" _
& "[AddressID] = " & Me!AddressID & ""))) Then
' Code if AddressID is not found - Insert record
Set db = CurrentDb
DoCmd.RunSQL "INSERT INTO [tblDependents]" _
& "(AddressID, LastName, FirstName, RelationshipID, CardTypeID, DateUpdated) " _
& "VALUES([AddressID], [LastName], [FirstName], 5, 4, Date());"
End If
Me.Requery
Me.Refresh
Me.Repaint
Exit Sub
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo DateUpdated_Err
With CodeContextObject
.DateUpdated = Date
End With
DateUpdated_Exit:
Exit Sub
DateUpdated_Err:
MsgBox Error$
Resume DateUpdated_Exit
End Sub
Private Sub Command19_Click()
On Error GoTo Err_Command19_Click
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.PrintOut acSelection
Exit_Command19_Click:
Exit Sub
Err_Command19_Click:
MsgBox Err.Description
Resume Exit_Command19_Click
End Sub