How to add code to make determine if something is unselected in a list box

[TheDocterd]

Hi All

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

[AndreRet]

I did not have time to test the code, but it should work fine. I have added a sub to ONLY load the mails AFTER you are done selecting the Items in List 1. Then before the mail call, I have called the sub.

Play around with it a bid if not 100%.

Dim xList As String

Private Sub ShowMail()

Dim intX As Integer
Cls

With List1
For intX = 0 To .ListCount - 1
    If .Selected(intX) Then
        personel.ListIndex = .ListIndex - 1

xList = xList & personel.Text & ";"

End If
Next

txtTest.Text = xList
End With
End Sub

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
End Sub
 
Private Sub Picture2_Click()
 
MsgBox "The following ID's are 2 days behind with time sheets: " + IDs 'Display ID's

Call ShowMail
'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 = xList
.Subject = Subject
.Body = Body
.Display
End With
 
Exit_Email:
Set objOL = Nothing
Exit Sub
 
'Err_Email:
'MsgBox "Error #" & Err.Number & ": " & Err.Description
'Resume Exit_Email
 
End Sub

[AndreRet]

Let me know before I duck outta here please.

[TheDocterd]

One error at line 18

txtTest.Text = xList

'Object required"

What is the txtTest.Text??

[AndreRet]

Oh, sorry, it was text box, just delete the line. You are using xList to paste the variables.

[TheDocterd]

Check the screen shots for my problem.

[AndreRet]

I had a look at the pics. You have selected 3 Id's. of which 3 was loaded in the To mail box. What is the problem?

I will be around, maybe will not check regularly, but will fall in from time to time.:)

stuur (PM) my jou mail adres. " me at There dot com" to not collect spam.

[TheDocterd]

Check the to box in the second screen shot. There are three of the same email adresses instead of three different one's

No problem will do so, thanks for the help.

[AndreRet]

Ah, I see. The pics are very blurry. Will test quickly and get back.

[AndreRet]

I changed the ShowMail sub. Forgot to advance the listindex to the next.:) Let me know how it went.

Soooo, problem solved, please mark as solved, thanks.

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

[TheDocterd]

Thanks AndreRet!! :) problem solved and no more errors

[AndreRet]

Pleasure. Now go have a cold one. Its Friday afternoon!!;)

[TheDocterd]

Will definitely! haha :)

[AndreRet]

Enjoy. Talk soon, Happy coding.:)