Me again :)
Seems like this problem will never end..
All works fine in my code, except it doesn't REMOVE the email addresses that are NOT 2 days behind. In my messagebox it displays all the ones that are behind, so that means I only want those in my 'to' section of my email. Instead it adds all the email addresses.
How can I handle this?
Here's my code and some screen shots attached for a better understanding
In the 2nd image you'll see that the emails are way more than what's displayed in the messagebox.
Dim xList As String Dim nFileNum As Integer, sText As String, sNextLine As String, lLineCount As Long Private Sub ShowMail() On Error Resume Next Dim intX As Integer With List1 .ListIndex = 0 For intX = 0 To .ListCount - 1 If .Selected(intX) Then personel.ListIndex = .ListIndex xList = xList & personel.Text & ";" End If .ListIndex = .ListIndex + 1 Next intX End With End Sub Private Sub Form_Load() List1.AddItem ("All") folder = Dir("Z:\ACS\Admin\ServU\JobBook\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 List1.ListIndex = -1 End Sub Private Sub List1_Click() If List1.ListIndex = 0 Then If List1.Selected(0) = True Then For j = 0 To List1.ListCount - 1 List1.Selected(j) = True Next j Else For j = 0 To List1.ListCount - 1 List1.Selected(j) = False Next j End If End If 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) = True Then 'If checked index is selected then ... For ix = 0 To nu - 1 If List1.List(i) = userlog(ix).UID Then filename = "Z:\ACS\Admin\ServU\JobBook\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) & " Days behind = " & DateDiff("d", CDate(Left(LineA, 10)), Now()) & Chr(13) End If End If Next End If Next MsgBox IDs 'Display ID's Call ShowMail Dim objOL As Outlook.Application Dim msg As Outlook.MailItem Set objOL = New Outlook.Application Set msg = objOL.CreateItem(olMailItem) ' Get a free file number nFileNum = FreeFile ' Open a text file for input. inputbox returns the path to read the file Open "C:\Template.txt" For Input As nFileNum lLineCount = 1 ' Read the contents of the file Do While Not EOF(nFileNum) Line Input #nFileNum, sNextLine 'do something with it 'add line numbers to it, in this case! sNextLine = sNextLine & vbCrLf sText = sText & sNextLine Loop ' Close the file Close nFileNum With msg .To = xList .Subject = sText .Body = sText .Display End With Exit_Email: Set objOL = Nothing Exit Sub End Sub