How to select multiple list items from 2 list boxes

[TheDocterd]

Hi there

I need to know how to select multiple list items from a list box. My code below only selects one email address when there's found that more than one ID's is behind schedule...

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 Picture2_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 & "ID " & List1.List(i) & " IDFrom" & CDate(Left(LineA, 10)) & " Now=" & Now() & " Datediff=" & DateDiff("d", CDate(Left(LineA, 10)), Now()) & Chr(13)
                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

MsgBox IDs 'Display ID's

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 = personel.List(List1.ListIndex)
.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]

Firstly, how are you selecting multiple items in List1? Show me the code or the steps. The same can be used in list 2 by using a similar loop to determine what indexes are selected in list1, then select the same in list2.

[monarchmk]

Hi again :)

Mulitple select is possible with this 2 rows

list1.list(list1.listindex) is selected line from list1
list2.list(list1.listindex) is line in list2 but in position where is list1.

also this can be implemented in above routine in this place (rows 23-26)

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
        sendmail(list2.list(i),"subject","body") 'In this line where IDs are joined you can sent mail. list2.list(i) is because i is row identifier here. Also list1.list is used with variable i
     End If

now in position of row 33 of your code add this 2 statements

EXIT SUB

Public Sub SendMail(Optional EmailTo As String, Optional Subject As String, Optional Body As String)

Now some explanation whats happening... As you are using my code for IDs, all ID's are grouped together FOR ...NEXT cycle in rows 15-28. with this cycle i go threw all listbox1 items to check if they are selected and if they are then i add them to simple string sield for later display. But in your code in line 41 .To = personel.List(List1.ListIndex) you get email address from user in position of last row that you are selected in list1 prior to clicking a command button. Thats why i break you procedure in 2 (line 33 with end sub) and add new procedure sendmail so in FOR..NEXT cycle for every ID i can get mail address from correct listbox2 position and send mail.

Now it this does not solve your problem, i could change procedure to use arrays, so you can send mail almouse wherever you like in your procedure.

And one suggestion, keep procedures simple, if there is a code that can be reused again, then put it in a function or procedure (as send mail code).

If you can't join thing together, later (i'm going to work now) i will join whole procedure for you :)

[TheDocterd]

Okay well my listbox1 has checkboxes next to the items, so I check those I want to and then the above code is run.

Listbox2 is a standard listbox that I is disabled next to listbox 1. The reason is because the indexes of both are the same, i.e listbox1's line 1 will be same as listbox2 line 1. for example '1001' (ID) in listbox 1 will have the email on listbox2 line 1 of say '[e-mail]' ..

[TheDocterd]

Thanks I did what you said but I get an error on this line:

sendmail(list2.list(i),"subject","body") 'In this line where IDs are joined you can sent mail. list2.list(i) is because i is row identifier here. Also list1.list is used with variable i

error says: '=' expected

And this is all my code now:

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 Picture2_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 & "ID " & List1.List(i) & " IDFrom" & CDate(Left(LineA, 10)) & " Now=" & Now() & " Datediff=" & DateDiff("d", CDate(Left(LineA, 10)), Now()) & Chr(13)
                IDs = IDs & IIf(Len(IDs) > 0, ",", "") & List1.List(i) 'Add id to listbox. You can construct this info how do you like
                Sendmail(personel.List(i),"subject","body")
            End If
    End If
Next

MsgBox "The following ID's are 2 days behind with time sheets: " + IDs 'Display ID's

On Error GoTo Err_Email

End Sub

Public Sub SendMail(Optional Subject As String, Optional Body As String)

Dim objOL As Outlook.Application
Dim msg As Outlook.MailItem

Set objOL = New Outlook.Application
Set msg = objOL.CreateItem(olMailItem)

With msg
.To = personel.List(List1.ListIndex)
.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]

I would have some code like -

'Every time you select an item in list1, under the list1 click event -
Dim xList As String
xList = xList & xList2.Text & "; " 'Remember that you have already called the selection in your loop from list1

[TheDocterd]

So where shall I then put this code?

[AndreRet]

'Every time you select an item in list1, under the list1 click event -
Dim xList As String
xList = xList & xList2.Text & "; " 'Remember that you have already called the selection in your loop from list1

As per my previous post.:)

[TheDocterd]

Still no luck :( don't know if placed it wrong..

If it helps here's my code (again) like i changed it:

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 xList As String

xList = xList & personel.Text & "; "

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) 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

MsgBox "The following ID's are 2 days behind with time sheets: " + IDs 'Display ID's

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 = personel.List(List1.ListIndex)
.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]

I'll paste all code and test from my side, just because you're an S.A. boytjie.

Will get back soon.:)

[AndreRet]

Please zip and attach your LogBook text file so I can test this properly, thanks.

[TheDocterd]

Remember to extrat it to your 'c:' drive. Also I gave only a few of the text files, it will still work though

[AndreRet]

Cool, I'll post a solution once I'm done.

[AndreRet]

And here is your solution.;)

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
 
'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

[monarchmk]

Try this code... Error was my mistake when you call a sub with () there must be = sign... So now i called without (). You have comment in changed lines 27, 38 and 48.
Unfortunately i can not check code on work since i work in linux... but it should work ok this way

This is solution to send separate mail to every employee. If you need to send only one mail to all employees then use @AnderRet sollution above.

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 Picture2_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 & "ID " & List1.List(i) & " IDFrom" & CDate(Left(LineA, 10)) & " Now=" & Now() & " Datediff=" & _
                  DateDiff("d", CDate(Left(LineA, 10)), Now()) & Chr(13)
                IDs = IDs & IIf(Len(IDs) > 0, ",", "") & List1.List(i) 'Add id to listbox. You can construct this info how do you like
                Sendmail personel.List(i),"subject","body" '!!NEW This line without parenthesis, my mistake
            End If
    End If
Next

MsgBox "The following ID's are 2 days behind with time sheets: " + IDs 'Display ID's

On Error GoTo Err_Email

End Sub

Public Sub SendMail(ToEmail as String, Optional Subject As String, Optional Body As String) 
'!!NEW Added ToEmail as String, is you call subs with 3 parameters then subs need to have at least 3 parameters

Dim objOL As Outlook.Application
Dim msg As Outlook.MailItem

Set objOL = New Outlook.Application
Set msg = objOL.CreateItem(olMailItem)

With msg
.To = ToEmail 
'!!NEW I replaced this line with ToEmail, It will receive email addresses from Command1_Click routine...
.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]

My solution was way shorter, sorry monarchmk.:)

I just added the variable, called it from there under the list1_click event. I have also moved your code before the email code to list1_click event. Works a charm.;)

[TheDocterd]

@AndreRet thanks man it works :), but it gives multiple email addresses. I'm thinking it is in (on your post) line 31-33.

@monarchmk also thanks :), but it opens multiple new emails instead of all the emails in one 'to' section.

[AndreRet]

This is what we both understood from your post.

Attach your personel text file here as well, or a sample so I can see exactly what you need.

[TheDocterd]

Both work, just minor bugs. I don't have a personel txt file. It is manually put into the personel listbox.

If I use your solution all goes well, but in the 'to' box it displays all the emails for every time I checked it in list box 1. Like say I check the first and third one and then decheck the first one it adds another email instead of one. Not a problem just have to make sure I click right.

And monarchmk's also works perfect, but just opens up a new mail for every one, instead of only one with email addresses all in one 'to' section

[AndreRet]

You can use the list1.ListIndex again to check if an item has been deselected. Use the checkbox values to check. That is however a new thread. Main topic was covered here, please mark as solved, dankie baie.:)

I'll play with the code and post a solution in your NEW thread.

[TheDocterd]

Ahhhhh I see but thanks guys for all your trouble!! I really appreciate it. :)

Will open another last thread to see if I can solve the last problem.

In afrikaans we say ek is julle hewig dankbaar!! ;)

[AndreRet]

In Afrikaans, Dis 'n moerse plesier.:)

We are however prohibited to use any other language than English here as per the posting rules so, It's a huge pleasure. I'll post a solution on the new thread. Happy coding.:)