AboutPricingCommunityTeamsStart Free TrialLog in
Avatar of isnoend2001
isnoend2001
Flag for United States of America asked on

modify a vb6 reminder project

i have a reminder program that is designed to run all the time, but in case it is unloaded for a period of time
the reminder due times are in a mshflexgrid and if the due time is past due then make the due time or date a minus amount
and
color the negative due time red eg;
In the Next Reminder column
-12 hours <- red text
-4 days<- red text
28921361.zip
Visual Basic Classic
Avatar of undefined
Last Comment
isnoend2001
8/22/2022 - Mon
Martin Liss
This can only be done for one-time dates since recurring dates are never overdue, and one-time times have no date associated with them and so "overdue" one-time reminders will be assumed to be for tomorrow.

In any case replace your timer1 code with this version which will take care of the one-time dates.
Private Sub Timer1_Timer()

Dim lngReminder As Long
Dim frm As Form
'******* Q28905119A Start *******
Dim fName As String
Dim strTime As String
'******* Q28914704I Start *******
Dim strName As String
Dim strType As String
'******* Q28914704I End *********
'******* Q28905119A End *********
'******* Q28910123I Start *******
Static bAdded As Boolean
Static intDayShown As Integer
'******* Q28914704A Start *******
'Static strTimeShown As String
'******* Q28914704A End *********
'******* Q28910123I End *********

With gridMaster
    For lngReminder = 1 To .Rows - 1
        If InStr(1, .TextMatrix(lngReminder, GRD_TIME_DATE), "M") > 0 Then
            ' It's a time reminder
            If .TextMatrix(lngReminder, GRD_DELAY) = "" Then
                ' It has not been delayed and it's time has come due
                If DateDiff("s", .TextMatrix(lngReminder, GRD_TIME_DATE), Format(Now, "short time")) = 0 Then
                    frmDeferTime.ReminderRow = lngReminder
                    frmDeferTime.Show vbModal
                    '******* Q28914704H Start *******
                    SaveData gridMaster
                    '******* Q28914704H End *********
                    '******* Q28905119A Start *******
                    'Exit Sub
                    '******* Q28905119A End *********
                Else
                    ' It has not been delayed and it's time has not yet come due
                    .TextMatrix(lngReminder, GRD_NEXT_REMINDER) = DetermineNextTaskTime(.TextMatrix(lngReminder, GRD_TIME_DATE), _
                                                                  Left$(.TextMatrix(lngReminder, GRD_FILE_NAME), 2))
                End If
            Else
                ' It's been delayed and so the GRD_DELAY column contains a value
                ' that is either the current date or "Done" and the current date
                If Left$(.TextMatrix(lngReminder, GRD_DELAY), Len(DONE)) <> DONE Then
                    ' "Done" is not found so show the form if the difference
                    ' between the delay time and now is 0, otherwise don't do
                    ' anything with it until tomorrow when the GRD_DELAY column will be cleared
                    If DateDiff("s", .TextMatrix(lngReminder, GRD_DELAY), Format(Now, "mm/dd/yyyy h:mm AM/PM")) = 0 Then
                        frmDeferTime.ReminderRow = lngReminder
                        frmDeferTime.Show vbModal
                        SaveData gridMaster
                        '******* Q28905119A Start *******
                        'Exit Sub
                        '******* Q28905119A End *********
                    '******* Q28914704H Start *******
                    Else
                        .TextMatrix(lngReminder, GRD_DELAY) = ""
                    '******* Q28914704H End *********
                    End If
                End If
            End If
        Else
            '******* Q28914704I Start *******
'            .TextMatrix(lngReminder, GRD_NEXT_REMINDER) = DetermineNextTaskTime(.TextMatrix(lngReminder, GRD_TIME_DATE), _
'                                                          Left$(.TextMatrix(lngReminder, GRD_FILE_NAME), 2))
            If DateDiff("d", .TextMatrix(lngReminder, GRD_TIME_DATE), Now) > 0 Then
                ' Get the name without the .rtf, get the type (e.g."Wk") and get the due date
                strName = Split(.TextMatrix(lngReminder, GRD_FILE_NAME), ".")(0)
                strType = Left$(strName, 2)
                Select Case strType
                    Case "Wk"
                        .TextMatrix(lngReminder, GRD_TIME_DATE) = Format(DateAdd("ww", 1, .TextMatrix(lngReminder, GRD_TIME_DATE)), "mm-dd-yyyy")
                    Case "Mo"
                        .TextMatrix(lngReminder, GRD_TIME_DATE) = Format(DateAdd("m", 1, .TextMatrix(lngReminder, GRD_TIME_DATE)), "mm-dd-yyyy")
                    Case "Yr"
                        .TextMatrix(lngReminder, GRD_TIME_DATE) = Format(DateAdd("yyyy", 1, .TextMatrix(lngReminder, GRD_TIME_DATE)), "mm-dd-yyyy")
                End Select
                .TextMatrix(lngReminder, GRD_NEXT_REMINDER) = DetermineNextTaskTime(.TextMatrix(lngReminder, GRD_TIME_DATE), strType)
                'new
                .Row = lngReminder
                .Col = GRD_NEXT_REMINDER
                If Left(.TextMatrix(lngReminder, GRD_NEXT_REMINDER), 1) = "-" Then
                    .CellForeColor = vbRed
                Else
                    .CellForeColor = vbBlack
                End If
                
            End If
            '******* Q28914704I End *********
        End If
    Next
    '******* Q28905119A Start *******
    fName = gstrFactOptions & "\Options.ini"
    Set IniSettings = New cInifile
     
    With IniSettings
       .Path = fName
       .Section = "Notification Time"
       .Key = "Notify Time"
       strTime = .Value
    End With
    
    '******* Q28910123I Start *******
     ' Restrict to running just once a day
     If intDayShown <> Day(Now) Then
        bAdded = False
    '******* Q28910123I End *********
        '******* Q28910123L Start (rewrote section) *******
        ' The daily agenda ("Date Alerts for Today") is shown once a day at
        ' the time stored in the ini file and this time comparison checks the
        ' current time against the ini file time to see if it's the proper time
        ' to show it. The "or" ensures that the form will be show on the day
        ' that the app is restarted, even if it's past the ini time.
        If (Format(Now, "HH:MM:SS") >= Format(strTime, "HH:MM") & ":00" And _
           Format(Now, "HH:MM:SS") <= Format(strTime, "HH:MM") & ":10") _
                                Or _
                gdteLastRun <> Format(Now, "short date") Then
            '******* Q28914704A Start *******
'            For lngReminder = 1 To .Rows - 1
'                Select Case .TextMatrix(lngReminder, GRD_REMINDER_TYPE)
'                    Case "Daily", "No Repeat"
'                        ' These are time-based reminders so skip them
'                    Case Else
            ' Do backwards so that the Alerts come out shortest first
           
'==========================================================================================================================
'            There are 12 different reminder situations that need to be considered.
'            The "SHOW" means that they should be in the Alerts
'
'            1.  A time-based reminder. They are always for today. SHOW
'
'            2.  A date-based reminder with notifications periods that don't match the current date
'            3.  A date-based reminder with notifications periods that don't match the current date but it's due now SHOW
'            4.  A date-based reminder with notifications periods that do match the current date SHOW
'
'            5.  A date-based reminder without notifications and it's due now SHOW
'            6.  A date-based reminder without notifications and it's not due now
'
'            7.  A "1d" (one time) date-based reminder with no notifications that's overdue SHOW (with color)
'            8.  A "1d" (one time) date-based reminder with notifications that's overdue SHOW (with color)

'           To summarize, cases 1, 3, 4, 5, 7, and 8 should be shown, 2 and 6 should not.
'==========================================================================================================================
            '******* Q28914704N Start *******
            ' Rewrote this part
            For lngReminder = .Rows - 1 To 1 Step -1
                If InStr(1, .TextMatrix(lngReminder, GRD_TIME_DATE), "M") = 0 Then
                    ' It's a date-based reminder
                    If .TextMatrix(lngReminder, GRD_NOTIFICATIONS) <> "" Then
                        ' The date-based reminder has notifications
                        If AddToAlertsDate(lngReminder, .TextMatrix(lngReminder, GRD_NOTIFICATIONS)) Then
                            ' Add those reminders with notification periods that match today
                            frmNotifcation.AddTask = .TextMatrix(lngReminder, GRD_REMINDER_DESC)
                            If .TextMatrix(lngReminder, GRD_TIME_DATE) = Format(Now, "mm-dd-yyyy") Then
                                ' Case 3
                                frmNotifcation.AddDate = "Today"
                            Else
                                ' Case 4
                                frmNotifcation.AddDate = .TextMatrix(lngReminder, GRD_TIME_DATE)
                            End If
                            bAdded = True

                        Else
                            If .TextMatrix(lngReminder, GRD_TIME_DATE) = Format(Now, "mm-dd-yyyy") Then
                                ' Case 7
                                ' The date-based reminder has notifications that don't match today
                                ' but it's due today
                                frmNotifcation.AddTask = .TextMatrix(lngReminder, GRD_REMINDER_DESC)
                                bAdded = True
                                frmNotifcation.AddDate = "Today"
                            ElseIf Left(.TextMatrix(lngReminder, GRD_FILE_NAME), 2) = "1d" Then
                                ' Case 8
                                ' It's overdue.
                                Select Case DateDiff("d", .TextMatrix(lngReminder, GRD_TIME_DATE), Now)
                                    Case 1
                                        frmNotifcation.EmphasisColor = RGB(255, 140, 0) ' Orange
                                        frmNotifcation.AddTask = .TextMatrix(lngReminder, GRD_REMINDER_DESC)
                                        frmNotifcation.AddDate = .TextMatrix(lngReminder, GRD_TIME_DATE)
                                        bAdded = True
                                    Case Is > 0
                                        frmNotifcation.EmphasisColor = RGB(255, 0, 0) ' Red
                                        frmNotifcation.AddTask = .TextMatrix(lngReminder, GRD_REMINDER_DESC)
                                        frmNotifcation.AddDate = .TextMatrix(lngReminder, GRD_TIME_DATE)
                                        bAdded = True
                                End Select
                           End If
                        End If
                    Else
                        ' It's a date-based reminder with no notifications
                         If .TextMatrix(lngReminder, GRD_TIME_DATE) = Format(Now, "mm-dd-yyyy") Then
                            ' Case 5
                            ' It's due today.
                            frmNotifcation.AddTask = .TextMatrix(lngReminder, GRD_REMINDER_DESC)
                            bAdded = True
                            frmNotifcation.AddDate = "Today"
                        Else
                            ' Case 7
                            ' It's a one-time date that's overdue.
                            If Left(.TextMatrix(lngReminder, GRD_FILE_NAME), 2) = "1d" Then
                                Select Case DateDiff("d", .TextMatrix(lngReminder, GRD_TIME_DATE), Now)
                                    Case 1
                                        frmNotifcation.EmphasisColor = RGB(255, 140, 0) ' Orange
                                        frmNotifcation.AddTask = .TextMatrix(lngReminder, GRD_REMINDER_DESC)
                                        frmNotifcation.AddDate = .TextMatrix(lngReminder, GRD_TIME_DATE)
                                        bAdded = True
                                    Case Is > 0
                                        frmNotifcation.EmphasisColor = RGB(255, 0, 0) ' Red
                                        frmNotifcation.AddTask = .TextMatrix(lngReminder, GRD_REMINDER_DESC)
                                        frmNotifcation.AddDate = .TextMatrix(lngReminder, GRD_TIME_DATE)
                                        bAdded = True
                                End Select
                            End If
                        End If
                    End If
                Else
                    ' It's time-based so show it.
                    frmNotifcation.AddTask = .TextMatrix(lngReminder, GRD_REMINDER_DESC)
                    frmNotifcation.AddDate = .TextMatrix(lngReminder, GRD_TIME_DATE)
                    bAdded = True
                End If
            Next
            '******* Q28914704N End *********
            
            '******* Q28910123I Start *******
            If Not bAdded Then
                frmNotifcation.AddTask = "No alerts for today"
                frmNotifcation.AddDate = "N/A"
                intDayShown = Day(Now)
            '******* Q28914704N Start *******
            Else
                intDayShown = Day(Now)
            '******* Q28914704N End *********
            End If
            If Not gbAlertsNeedToBeShown Then
                intDayShown = Day(Now)
            End If
            '******* Q28910123I End *********
        End If
    '******* Q28910123I Start *******
    End If
    '******* Q28910123I End *********
   
    '******* Q28914704A Start *******
    ' Check time reminders
'    For lngReminder = 1 To .Rows - 1
'        Select Case .TextMatrix(lngReminder, GRD_REMINDER_TYPE)
'            Case "Daily", "No Repeat"
'                If strTimeShown <> .TextMatrix(lngReminder, GRD_TIME_DATE) Then
'                    If AddToAlertsTime(lngReminder, .TextMatrix(lngReminder, GRD_NOTIFICATIONS)) Then
'                        Set frm = New frmNotifcation
'                        frm.AddTask = .TextMatrix(lngReminder, GRD_REMINDER_DESC)
'                        frm.AddDate = .TextMatrix(lngReminder, GRD_TIME_DATE)
'                        ' Possibly show more than one instance of frmNotification
'                        strTimeShown = .TextMatrix(lngReminder, GRD_TIME_DATE)
'                        frm.ReportType = "Time"
'                        frm.Show
'                    End If
'            End If
'        End Select
'    Next
    '******* Q28914704A End *********
    '******* Q28905119A End *********
End With
End Sub

Open in new window

isnoend2001
ASKER
I made 4 reminders and the detail grid was not updated unless i opened it twice
reacurring dates can be over due.
what if you forget a birthday ?, you have no way of knowing
ASKER CERTIFIED SOLUTION
Martin Liss
THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
isnoend2001
ASKER
I made 4 reminders and the detail grid was not updated unless i opened it twice
i made a weekly reminder with with the text "weekly date" and no notifications
click ok on this message
use description went back to the main form and clicked view and the detail still said "Enter details  of this Reminder here"
clicked to go back to the main by clicking the X and got the msgbox that no details and the description
would be entered. clicked Ok . clicked view again and it was correct and said "weekly date"
after the 2nd time i made no changes, but got a msgbox
changes savedi made no changes, but the rtf now said "weekly date" as it should have the first time
This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
rwheeler23
isnoend2001
ASKER
Thank you
Plans and Pricing
Resources
Product
Podcasts
Careers
Contact Us
Teams
Certified Expert Program
Credly Partnership
Udemy Partnership
Privacy Policy
Terms of Use

© 1996-2023 Experts Exchange, LLC. All rights reserved. Covered by US Patent