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