Hi All

I don't actually know how to explain my problem, but here goes..

I have a small form. It has a listbox with a submit button. In the list box there are ID's displayed, i.a 10027, 10028, etc. Those ID's are the names of text files that have logbook data in them, i.a dates and jobs did on that date.

What I would like to do is to tick some ID's displayed in the listbox in their checkboxes supplied and when the submit button is clicked to run some code that would determine when last it was filled in, i.a two days before the current date at that time by looking at the date in the text file found at the beginning of every line. When that is done it must just display the ID's of those who are indeed behind in say for instance something like a messagebox.

Any ideas would be appreciated..

Thanks in advance,
TheDocterd

What you need to be displayed in MessageBox?
Is date same for every row in file?
Is the location of all files in same folder?
Format of the date? dd/mm/yyyy or dd-mm-yyyy or dd,MMMM YYYY or similar? example maybe?

When you check ID's, you will get dates of every ID and then what would you lake to be done with those dates?

Ok, here is some sample code...

You need
Listbox (in sample ) List1
Command button Command1 in sample just for activating
For Path I used C:\###.txt - Please Change in Line 11
Date parser is in row 15 but it is just sample, i do not know date format that you are using
And i still does not have a clue what to display in msgbox :?:

Private Sub Command1_Click()
Dim DateA()
Dim DateRow As Integer
ReDim DateA(List1.ListCount)

DateRow=1

For I = 0 To List1.ListCount - 1

    If List1.Selected(I) Then
        FileName = "c:\" + List1.List(List1.ListIndex) + ".txt"
        Open FileName For Input As #1
        Line Input #1, LineA
        Close #1
        DateA(DateRow) = Left$(LineA, 10) ' This is sample for date parser ...
        DateRow = DateRow + 1
    End If

Next

'Now here you have
'DateRow - how much dates you have
'DateA() - dates retreived from files...
'You can use 
'For i = 1 to DateRow
'     msgbox DateA(i)
'next
'or something like this :)
End Sub

Edited 5 Years Ago by monarchmk: n/a

okay well the date format is the format yyyy-mm-dd and yes it is the same on every line. :)

The location of all files is all in the same folder and it doesn't matter what is displayed in the messagebox as long as I can see the ID's in the messagebox. It doesn't really matter ;)

When I check the dates of every ID (i.a it is all of the txt files) when it has checked all of text files (ID's) it must determine where there are dates that are two days behind the current date (DateTime now). When done it should then display the ID's of those who are indeed behind in a messagebox.

Did I explain correct now? This function is for me to monitor what personel isn't on time with their logbooks.

Ok..

You need,
One Listbox named List1.In property of ListBox please change MultiSelect to 1 (as it is readonly in runtime so i could not change it in code)
One CommandButton named Command1
and this code... (put it in form code, Code replaces FORM_LOAD and COMMAND1_CLICK procedures) If you have procedure for filling list1, do not use mine, use only parts that you need.

Private Sub Form_Load() ' On form loading do...
folder = Dir("e:\vbtest\*.txt") 'variable folder conatins names of files in folder e:\vbtest\ with extension *.txt
    While Len(folder) <> 0 'loop while length of folder is 0 which means no file found...
        List1.AddItem Left(folder, InStr(folder, ".txt") - 1) 'add file to list, but trim .txt extension..
        folder = Dir() 'read again
    Wend

End Sub 'End of form load


Private Sub Command1_Click() 'After selecting id's in listbox, you will click on command button 1, this is procedure
Dim IDs As String

For i = 0 To List1.ListCount - 1 'do loop within all od list1 indexes
    If List1.Selected(i) Then 'If checked index is selected then ...
        FileName = "e:\vbtest\" + List1.List(i) + ".txt" 'Construct filename, add folder and extension
        Open FileName For Input As #1 'Open file for reading
             Line Input #1, LineA 'Since all dates are same i will read only 1st row
        Close #1 'Close file
            If DateDiff("d", CDate(Left(LineA, 10)), Now()) > 2 Then 'If difference between now and readed date is more than 2 days ("d")
                IDs = IDs & IIf(Len(IDs) > 0, ",", "") & List1.List(i) 'Add id to listbox. You can construct this info how do you like
            End If
    End If
Next
MsgBox IDs 'Display ID's

End Sub

Now what this do...
I try to comment every line of code, basically it loops between all ID's and check for selected ID's if difference of dates are 2 days or more ( i suppose 2 days behind means this)... if it is, procedure remembers ID for later display. Try this code and write if there are some problems.
Tomorrow I'll be on trip so I'll have very limited access, but i'll try to catchup

P.S. If you need more info you can replace ID's row 21 with this line

IDs = IDs & "ID " & List1.List(i) & " IDFrom" & CDate(Left(LineA, 10)) & " Now=" & Now() & " Datediff=" & DateDiff("d", CDate(Left(LineA, 10)), Now()) & Chr(13)

and you will get something similar to this
ID 10 IDFrom05.03.2011 Now=08.03.2011 23:49:19 DateDiff=3
ID 11 IDFrom04.03.2011 Now=08.03.2011 23:49:19 Datediff=4...

Edited 5 Years Ago by monarchmk: n/a

This is exactly what i need :)

just another question how do the part where I read the 1st line to read instead the last line of every file? The amount of lines in every file will vary.

easy :)

replace line 18 (Line Input #1, LineA)
with this code

While Not EOF(1)
              Line Input #1, LineA 'Since all dates are same i will read only 1st row
        Wend

it will loop until it is end of File (EOF) 1 in parenthesis is index number of file that you opened in line 17.

And please mark thread SOLVED if everything is OK.

Edited 5 Years Ago by monarchmk: n/a

Ahhh thanks for all the help :) I just have one last question..

I added a second listbox to my form with email addresses. Those email addresses is the email of person behind the ID's in the first listbox. It's put in manually because the text files won't get more so it will always match up.

Say for instance listbox 1 displays '1001' and listbox 2 displays 'johan@abcworld.co.za'. The second listbox is disabled as it must determine the following by himself...

All I want to do now is to just take the emails in the second listbox from those ID's who are behind and shown in my messagebox (We can take away the messagebox now and instead proceed with this) and just put those emails in outlook's 'To:' section.

Is it clear enough? This is a previous piece of code I have to go to outlook through vb, but it's gonna need some modification.

Public Sub SendMail(Optional EmailTo As String, Optional Subject As String, Optional Body As String)

On Error GoTo Err_Email

Dim objOL As Outlook.Application
Dim msg As Outlook.MailItem

Set objOL = New Outlook.Application
Set msg = objOL.CreateItem(olMailItem)

With msg
.To = EmailTo
.Subject = Subject
.Body = Body
'.Attachments.Add tempFile
.Display
'.send
End With

Exit_Email:
Set objOL = Nothing
Exit Sub

Err_Email:
MsgBox "Error #" & Err.Number & ": " & Err.Description
Resume Exit_Email

End Sub

If i understand correctly.. list1 and list2 are aligned (item X on list1 is item X on list2??) then it is not a problem.

list1.list(list1.listindex) is selected line from list1
list2.list(list1.listindex) is line in list2 but in position where is list1.

Great stuff :) so where will I then put this code?

In line 12 can I change it so that it looks like this:

.To = list2.list(list1.listindex)

Or where else shall I put it?

You will have to add the code under the list1_Click/Change event. Declare a variable, at the top of your code form -

Dim xList As String)

'Under the list1 event, add the following -
xList = List2.Text

'Now, in the code you supplied for email - "To" add -
.To = xList

'Every time that List1 chenges, List2 changes to the next email address. When sending the mail, the correct recipient is saved in the variable 'xList'

that correct but he goes threw loop in list1 (multiple IDs can be checked) so somewhere in loop will be good place to put a call to sendmail routine...

this below is part of my previous code, if you using it you can modify it or if you use another code, thisi is only to give you idea where to put calls...(see red line with comment)
This part use your routine for sending mails, i call sendmail with all parameters so both will work together

...
...
...
Private Sub Command1_Click() 'After selecting id's in listbox, you will click on command button 1, this is procedure
Dim IDs As String


For i = 0 To List1.ListCount - 1 'do loop within all od list1 indexes
    If List1.Selected(i) Then 'If checked index is selected then ...
        FileName = "e:\vbtest\" + List1.List(i) + ".txt" 'Construct filename, add folder and extension
        Open FileName For Input As #1 'Open file for reading
             Line Input #1, LineA 'Since all dates are same i will read only 1st row
        Close #1 'Close file
            If DateDiff("d", CDate(Left(LineA, 10)), Now()) > 2 Then 'If difference between now and readed date is more than 2 days ("d")
                IDs = IDs & IIf(Len(IDs) > 0, ",", "") & List1.List(i) 'Add id to listbox. You can construct this info how do you like
                 [b]sendmail(list2.list(i),"subject","body") 'In this line where IDs are joined you can sent mail. list2.list(i) is because i is row identifier here. Also list1.list is used with variable i[/b]
            End If
    End If
Next
MsgBox IDs 'Display ID's

End Sub

Edited 5 Years Ago by monarchmk: n/a

AndreRet that works perfect, but like monarchmk said I use a loop.

I get a syntax error on the line of that sendmail code.. It says there's a '=' expected.

Here is my code for whole thing so far..It opens up a new message in outlook, but does not display the emails in the 'To' section of the ID's that are 2 days behind.

Private Sub Form_Load()

folder = Dir("c:\LogBook\*.txt") 'variable folder conatins names of files in folder c:\LogBook\ with extension *.txt
    While Len(folder) <> 0 'loop while length of folder is 0 which means no file found...
        List1.AddItem Left(folder, InStr(folder, ".txt") - 1) 'add file to list, but trim .txt extension..
        folder = Dir() 'read again
    Wend

End Sub

Private Sub Picture2_Click()

Dim IDs As String

For i = 0 To List1.ListCount - 1 'do loop within all od list1 indexes
    If List1.Selected(i) Then 'If checked index is selected then ...
        filename = "c:\LogBook\" + List1.List(i) + ".txt" 'Construct filename, add folder and extension
        Open filename For Input As #1 'Open file for reading
        While Not EOF(1)
            Line Input #1, LineA 'Since all dates are same i will read only 1st row
        Wend
        Close #1 'Close file
            If DateDiff("d", CDate(Left(LineA, 10)), Now()) > 2 Then 'If difference between now and readed date is more than 2 days ("d")
                ''IDs = IDs & "ID " & List1.List(i) & " IDFrom" & CDate(Left(LineA, 10)) & " Now=" & Now() & " Datediff=" & DateDiff("d", CDate(Left(LineA, 10)), Now()) & Chr(13)
                IDs = IDs & IIf(Len(IDs) > 0, ",", "") & List1.List(i) 'Add id to listbox. You can construct this info how do you like
                sendmail(personel.List(i),"subject","body") ''In this line where IDs are joined you can sent mail. list2.list(i) is because i is row identifier here. Also list1.list is used with variable i
            End If
    End If
Next

MsgBox IDs 'Display ID's

On Error GoTo Err_Email

Dim objOL As Outlook.Application
Dim msg As Outlook.MailItem

Set objOL = New Outlook.Application
Set msg = objOL.CreateItem(olMailItem)

With msg
.To = ????
.Subject = Subject
.Body = Body
'.Attachments.Add tempFile
.Display
'.send
End With

Exit_Email:
Set objOL = Nothing
Exit Sub

Err_Email:
MsgBox "Error #" & Err.Number & ": " & Err.Description
Resume Exit_Email

End Sub

Okay well I got it right there is just one more small problem. My list box 2 (a.k.a personel) sorts alphabetically, how do I undo this?

This is my code now:

Private Sub Form_Load()

folder = Dir("c:\LogBook\*.txt") 'variable folder conatins names of files in folder c:\LogBook\ with extension *.txt
    While Len(folder) <> 0 'loop while length of folder is 0 which means no file found...
        List1.AddItem Left(folder, InStr(folder, ".txt") - 1) 'add file to list, but trim .txt extension..
        folder = Dir() 'read again
    Wend

End Sub

Private Sub Picture2_Click()

''Dim xList As String

Dim IDs As String

'Under the list1 event, add the following -
''xList = personel.Text

For i = 0 To List1.ListCount - 1 'do loop within all od list1 indexes
    If List1.Selected(i) Then 'If checked index is selected then ...
        filename = "c:\LogBook\" + List1.List(i) + ".txt" 'Construct filename, add folder and extension
        Open filename For Input As #1 'Open file for reading
        While Not EOF(1)
            Line Input #1, LineA 'Since all dates are same i will read only 1st row
        Wend
        Close #1 'Close file
            If DateDiff("d", CDate(Left(LineA, 10)), Now()) > 2 Then 'If difference between now and readed date is more than 2 days ("d")
                ''IDs = IDs & "ID " & List1.List(i) & " IDFrom" & CDate(Left(LineA, 10)) & " Now=" & Now() & " Datediff=" & DateDiff("d", CDate(Left(LineA, 10)), Now()) & Chr(13)
                IDs = IDs & IIf(Len(IDs) > 0, ",", "") & List1.List(i) 'Add id to listbox. You can construct this info how do you like
            End If
    End If
Next

MsgBox IDs 'Display ID's

On Error GoTo Err_Email

Dim objOL As Outlook.Application
Dim msg As Outlook.MailItem

Set objOL = New Outlook.Application
Set msg = objOL.CreateItem(olMailItem)

With msg
.To = personel.List(List1.ListIndex)
.Subject = Subject
.Body = Body
'.Attachments.Add tempFile
.Display
'.send
End With

Exit_Email:
Set objOL = Nothing
Exit Sub

Err_Email:
MsgBox "Error #" & Err.Number & ": " & Err.Description
Resume Exit_Email

End Sub

Edited 5 Years Ago by TheDocterd: n/a

Change list2.Sorted property to False. You can do this by using the property to the right in design time or under code -

List2.Sorted = False

Do the same for List1 so that their index's is the same with the info supplied, in other words, index1 = "1002" and the email for that id = "me@there.com", which will be on the same index, list2 - 1

Got that! ;)

It displays only one email if I select multiple ID's to check??

Edited 5 Years Ago by TheDocterd: n/a

That will be off topic, unfortunately, which was the case with the last two questions.:)

You need to open a new thread with your question - "How to select multiple list items from 2 list boxes". We will answer from there. Also post your code there as well.

Please DO NOT mark this as solved until monarchmk replied to this, he gave you the full solution, I would like to let him have the solution point, thanks.

@Monarchmk, please reply something here, but please do not answer the multiple list question, other readers will get confused, and we are off topic. Lets try and keep the answers to specific questions, thanks guys.:)

Thanks for all your help Monarchmk.

It really helped a lot!!

:)

Comments
Thanks for keeping open for Monarchmk.:)

@AndreRet Thanks :)

@TheDoctored - Even when it is offTopic, i already provide you with solution of your 2 problems in my answers. You have parts of solution how to synchronize both listboxes and solution about muliple IDs and only one mail :). however, open new topic so we will solve that issue

Edited 5 Years Ago by monarchmk: n/a

This question has already been answered. Start a new discussion instead.