Link to home
Start Free TrialLog in
Avatar of isnoend2001
isnoend2001Flag for United States of America

asked on

modify vb6 code

I have a vb6 program that checks for reminders. the files are saved with the due date as the file name
i am trying to modify it to create a file 1 year later when the file is  deleted
if ckEveryYear is checked the filename would then be eg: Yr01-03-2017.rtf
It loads the listbox fine, but trying to check them for due dates gives an error(type mismatch)
ckEveryYear
Dim TaskDate As Date
    myDate = Date
listbox contents
01-03-2017.rtf
02-20-2016.rtf
03-10-2016.rtf
06-23-2016.rtf
07-26-2016.rtf
08-06-2015.rtf
09-25-2015.rtf
11-18-2015.rtf
11-29-2015.rtf
12-01-2015.rtf
12-26-2015.rtf
Yr01-03-2017.rtf

 For i = 0 To cboTasks.ListCount - 1
this line now has error (Type mismatch) when it tries to process Yr01-03-2017.rtf:
    TaskDate = CDate(Left$(cboTasks.List(i), Len(cboTasks.List(i)) - 4)) - miFirstReminderDays '4
How can this be corrected ?
Avatar of Martin Liss
Martin Liss
Flag of United States of America image

Can you supply a sample project?
Avatar of isnoend2001

ASKER

Yes Attached
Tasks.zip
Try this.

Private Sub cboTasks_Click()
   Dim TaskDate As Date
   Dim strName As String
   Dim lngChar As Long
   mbKeepFormVisible = True
        Me.rtfTask.Text = ""
    If cboTasks.ListIndex <> -1 Then
        If IsNumeric(Left$(cboTasks.Text, 1)) Then
            strName = cboTasks.Text
        Else
            For lngChar = 1 To Len(cboTasks.Text)
                If IsNumeric(Mid$(cboTasks, lngChar, 1)) Then
                    strName = Mid$(cboTasks.Text, lngChar)
                    Exit For
                End If
            Next
        End If
        TaskDate = CDate(Left$(strName, Len(strName) - 4)) '- miReminderDays
        txtTaskDate = TaskDate
        OpenFile cboTasks.Text
        mbFactMode = False
    End If
End Sub

Open in new window

sorry i left an exit sub in the code
Thanks that probably works but the error is in this sub:
Sub LoopThruDates()
    Dim TaskFound As Boolean
    Dim i As Integer
    Dim myDate As Date
    Dim TaskDate As Date
    myDate = Date
    Exit Sub This needs to be removed to produce the error
 For i = 0 To cboTasks.ListCount - 1
    TaskDate = CDate(Left$(cboTasks.List(i), Len(cboTasks.List(i)) - 4)) - miFirstReminderDays '4
   
  If TaskDate = myDate Then
    TaskFound = True
    txtTaskDate = TaskDate + miFirstReminderDays
    cboTasks.ListIndex = i
    OpenFile cboTasks.List(i)
    mbTaskIsDirty = False
    Call MsgBox("You have a scheduled task to consider in " & miFirstReminderDays & " days", vbInformation, "Needs attention")
    Me.Visible = True
    mbFactMode = False
    Exit Sub
   
    Exit For
   
 
  End If
 Next
 'Prompt again if not deleted if date requires
   For i = 0 To cboTasks.ListCount - 1
    TaskDate = CDate(Left$(cboTasks.List(i), Len(cboTasks.List(i)) - 4)) - miReminderDays
  If TaskDate = myDate Then
    TaskFound = True
    txtTaskDate = TaskDate + miReminderDays
    cboTasks.ListIndex = i
    OpenFile cboTasks.List(i)
    mbTaskIsDirty = False
    Call MsgBox("You have a scheduled task to consider in " & miReminderDays & " days", vbInformation, "Needs attention")
    Me.Visible = True
    mbFactMode = False
    Exit Sub
    Exit For
'    Else
'    Unload Me
  End If
Next

 For i = 0 To cboTasks.ListCount - 1
    TaskDate = CDate(Left$(cboTasks.List(i), Len(cboTasks.List(i)) - 4)) '- miReminderDays
  If TaskDate <= myDate Then
    TaskFound = True
    txtTaskDate = TaskDate '+ miReminderDays
    cboTasks.ListIndex = i
    OpenFile cboTasks.List(i)
    mbTaskIsDirty = False
    Call MsgBox("Past due ", vbInformation, "Needs attention")
    Me.Visible = True
    mbFactMode = False
    Exit Sub
    Exit For
'    Else
'    Unload Me
  End If
Next

End Sub
I'll get back to you in the morning.
I had already removed the Exit Sub and I believe that the code I posted above corrects your problem.
Thanks, but the error occurs on form load after the listbox is populated
in this sub:
Sub LoopThruDates on this line:
TaskDate = CDate(Left$(cboTasks.List(i), Len(cboTasks.List(i)) - 4)) - miFirstReminderDays '4
it works fine until it reaches a file name with Yr at the beginning eg;  Yr01-03-2017.rtf
all the other files work and do not produce n error
Did you actually try my code because that's not what I experienced. In order for me to have data to work with I changed the Form_Load sub as shown. I uncommented and changed lines 37 to 43 and added the file name you were having a problem with.
Private Sub Form_Load()
Dim i As Integer
Dim fName As String
'CheckDirectory "C:\Backups", True 'created if missing
'CheckDirectory "C:\Backups\Tasks\", True 'created if missing
 'mbHideForm = False 'do not hide the form
'fName = "C:\Backups\Tasks\" & "NewTask.rtf"
'fName = App.Path & "\Loan Agreement.rtf"
 'ListFiles "C:\Backups\Tasks\" 'fill the lstbox with saved files
 ListFiles gTasksFolder
        For i = 1 To Screen.FontCount - 1
           If Screen.Fonts(i) <> "" Then cboFont.AddItem Screen.Fonts(i)
       Next i
       
       For i = 5 To 12 Step 1
           cboSize.AddItem i
       Next
       
       For i = 14 To 28 Step 2
           cboSize.AddItem i
       Next
       
       cboSize.AddItem 36
       cboSize.AddItem 48
       cboSize.AddItem 72
       cboFont.Text = "Arial"
       cboSize.Text = "10"
     miFirstReminderDays = Val(txtFirstReminderDays)
 miReminderDays = Val(Me.txtReminderDays)

' Me.Visible = False 'only used for running invisible
'Timer1.Interval = 1000 ' 1 second
'Timer1.Enabled = True

LoopThruDates 'find if reminder by checking filenames in C:\Backups\Tasks\
'Example:
cboTasks.AddItem "02-20-2016.rtf"
cboTasks.AddItem "02-28-2015.rtf"
cboTasks.AddItem "03-10-2015.rtf"
cboTasks.AddItem "03-10-2016.rtf"
cboTasks.AddItem "06-23-2015.rtf"
cboTasks.AddItem "06-23-2016.rtf"
cboTasks.AddItem "Yr01-03-2017.rtf"
'07-04-2016.rtf
'Debug.Print App.Path & "\VisibleTasks.exe"
'Chill 30 'for running invisible to unload form from memory if no task due
End Sub

Open in new window

After that I removed the Exit Sub line you mentioned and found that if I selected "Yr01-03-2017.rtf" from the combobox that I got the type mismatch error. However when I changed the cboTasks_Click event as I posted above, there was no more error.
Thanks the LoopThruDates needs to come after the listbox is loaded
the LoopThruDates processes the contents of the listbox
ASKER CERTIFIED SOLUTION
Avatar of Martin Liss
Martin Liss
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thanks Marty
Glad you are still here (or there)
You're welcome.
I am going to post another question for creating a file with the date one year more
when the file is deleted if the filename starts with Yr