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 ?
isnoend2001Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
Can you supply a sample project?
0
isnoend2001Author Commented:
Yes Attached
Tasks.zip
0
Martin LissOlder than dirtCommented:
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

0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

isnoend2001Author Commented:
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
0
Martin LissOlder than dirtCommented:
I'll get back to you in the morning.
0
Martin LissOlder than dirtCommented:
I had already removed the Exit Sub and I believe that the code I posted above corrects your problem.
0
isnoend2001Author Commented:
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
0
Martin LissOlder than dirtCommented:
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.
0
isnoend2001Author Commented:
Thanks the LoopThruDates needs to come after the listbox is loaded
the LoopThruDates processes the contents of the listbox
0
Martin LissOlder than dirtCommented:
Replace cboTasks_Click and LoopThruDates subs and add the DateFromName function.
Private Sub cboTasks_Click()
   Dim TaskDate As Date
   Dim strName As String
   
   mbKeepFormVisible = True
        Me.rtfTask.Text = ""
    If cboTasks.ListIndex <> -1 Then
        strName = DateFromName(cboTasks.Text)
        TaskDate = CDate(Left$(strName, Len(strName) - 4)) '- miReminderDays
        txtTaskDate = TaskDate
        OpenFile cboTasks.Text
        mbFactMode = False
    End If
End Sub
Sub LoopThruDates()
    Dim TaskFound As Boolean
    Dim i As Integer
    Dim myDate As Date
    Dim TaskDate As Date
    Dim strName As String
    
    myDate = Date
    For i = 0 To cboTasks.ListCount - 1
    strName = DateFromName(cboTasks.List(i))

    TaskDate = CDate(Left$(strName, Len(strName) - 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
    strName = DateFromName(cboTasks.List(i))
    TaskDate = CDate(Left$(strName, Len(strName) - 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
Private Function DateFromName(strFileName As String) As String

    Dim lngChar As Long

    If IsNumeric(Left$(strFileName, 1)) Then
        DateFromName = strFileName
    Else
        For lngChar = 1 To Len(strFileName)
            If IsNumeric(Mid$(strFileName, lngChar, 1)) Then
                DateFromName = Mid$(strFileName, lngChar)
                Exit Function
            End If
        Next
    End If

End Function

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
isnoend2001Author Commented:
Thanks Marty
Glad you are still here (or there)
0
Martin LissOlder than dirtCommented:
You're welcome.
0
isnoend2001Author Commented:
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
0
Martin LissOlder than dirtCommented:
OK
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.