Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

I have a module on my main form tha

Status
Not open for further replies.

DomFino

IS-IT--Management
Jul 9, 2003
278
0
0
US
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.



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
 
I'm curious about this myself. You can try moving all the code that occurs on Form_Open() to Form_Load(), and that means it runs after the controls/form data source has loaded. But it still doesn't allow screen updates. My (admittedly bad) workaround for this is to do the following:

-Set form timer to 100ms or some other arbitrary number
-create a form_Timer() event.
-go to the top of the module, create a "fHasRun" boolean flag that keeps track of whether you have run your code yet or not.
-on Form_Open(), fHasRun = false
-on Form_Timer(), put all your birthday checking code. At the TOP of this function, check
Code:
If fHasRun = True Then
    Exit Sub
Else
    Me.TimerInterval = 0
    fHasRun = True
End If

'(rest of your code here)


This will basically run your code on the first (and ONLY first) timer event. It works, though it is NASTY ugly. Anyone with a better solution, let me (us) know.
 
foolio12,
You are a genius. I would have never figured that out in a million years. It works like a dream. Here is the final code that I used based on your suggestions. Thank you so much for the quick reply and the expert advise.
Dom

Option Compare Database
Option Explicit
Dim mvarPostalCode
Dim fHasRun As String

Private Sub Form_Resize()
DoCmd.Maximize
End Sub

Private Sub Form_Open(Cancel As Integer)
Me.Filter = ""
Me.FilterOn = True
fHasRun = False
End Sub

Private Sub Form_Timer()
If fHasRun = True Then
Exit Sub
Else
Me.TimerInterval = 0
fHasRun = True
End If
'********************************************************************
'
'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
[/code]
*************************************************
'rest of my code
 
I think that if you had just modified your original form Load event as follows, that the form would have displayed itself prior to the MsgBox dialog poping up...

lngCount = rstItems.RecordCount
DoEvents
If lngCount > 0 Then
MsgBox "You have Birthday cards to send"
End If

The "DoEvents" line would have allowed the form to paint itself on screen, and there would have been no need to work with the timer event.
 
LambertH,
Thanks for your input. For grins, I removed the timer event as you suggested and input the DoEvents command. You are absolutely correct. It worked and there is less code to deal with. Again, I want to thank you and foolio12 for your suggestions. Both work. One has a bit less code.
Dom
 
Hi DomFino,

No relation to your problem but I note at the top of your code you have ..

Code:
Private Sub Form_Resize()
  DoCmd.Maximize
End Sub

I can imagine what you are trying to do but it feels wrong because Maximize should trigger the Resize event and the whole thing should disappear in a puff of smoke. I tested it with mixed results. Do you know what it is doing?

Enjoy,
Tony
 
Tony,
I found that bit of code on a site (can't remember where) and it was in relation to a question a person had that went something like this. "I have a form that does not open to full size all the time. How can I make it open in full size every time the database is open?" The person that responded used the code I have incorporated in the resize section. It always works for me! That is, whenever I open the database the initial form is maximized.
Dom
 
Out the msgbox that tells you about the birthdays... why not have a "status bar" on your form that is not visible unless there are birthday cards to send. Then, the code would either:

Just set the "status bar" (a label) to visible, then when you check the birthdays, it can be set to invisible.

Or

Set the "status bar" (a text box) with the information that would have gone into the msgbox, and then set it to visible.

That way, you don't have to worry about timers.. and you can use the text box for other status information as well.

You can make the status bar look anyway you want... like red background with yellow letters (or vice versa)...

Just another way to go....

GComyn
 
GComyn,
Thanks for the suggestion. I may use that on another application I am working on. I kind of like the idea of a hidden status with intelligence behind it.

For my current application, I have the message box pop up and then when I click OK, the message box closes and a report opens with the name and birthdates of those that meet the criteria. I know. Sounds silly but the folks here think it is slick. Thanks again to everyone for some great ideas.
Dom
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top