I really had some awesome feedback on my problem and finally I came to the last bit. I want to add/modify my code to make sure that multiple emails aren't added due to my selection method of my list box.
AndreRet helped me with this and also monarchmk for which I am grateful so will you guys help again please?
My problem lieas at the of the list1 event handler.
Dim xList As String 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 List1_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 & 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 personel.ListIndex = List1.ListIndex xList = xList & personel.Text & "; " End Sub Private Sub Picture2_Click() MsgBox "The following ID's are 2 days behind with time sheets: " + IDs 'Display ID's Dim objOL As Outlook.Application Dim msg As Outlook.MailItem Set objOL = New Outlook.Application Set msg = objOL.CreateItem(olMailItem) With msg .To = xList .Subject = Subject .Body = Body .Display End With Exit_Email: Set objOL = Nothing Exit Sub End Sub