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

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
        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
             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
    End If

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
' Close the file
Close nFileNum
With msg
.To = xList
.Subject = sText
.Body = sText
End With
Set objOL = Nothing
Exit Sub

End Sub

I am at a loss here with all this code. xList is loading correctly, so your problem is hiding somewhere else.:)

Mail me your form, code and sample text files (don't need the original, just sample text added) AGAIN so I can test ALL the code without me re-creating everything from scratch again. I'll post a solution here after testing.

This article has been dead for over six months. Start a new discussion instead.