Loop through selected items in listbox, then email

[Kurt]

I adopted the code at http://www.granite.ab.ca/access/email/recordsetloop.htm
to allow me to loop through records in a table and send an email to each
person in the table, one at a time, while adding a report to each email
unique to that person. It works great, but …

Instead of looping through records in a table, I’d like to loop through the
items (email addresses) selected in a multi-select list box. Emails can be
selected either with a “Select All†button or individually.

Is it possible to do this? I’ve searched around and found many different
ways to loop through a list box, but none designed with an email process in
mind. My hope is that I can simple simply edit my current email code to loop
through the list box instead of the table. I rarely use listboxes so the
syntax is quite new to me.

Thanks for any suggestions. Kurt

Private Sub cmdEmail_Click()

Dim MyDB As Database, RS As Recordset
Dim strDocName As String
Dim strTo As String
Dim lngRSCount As Long

strDocName = Me.lstRpt

DoCmd.RunCommand acCmdSaveRecord
Set MyDB = DBEngine.Workspaces(0).Databases(0)

Set RS = MyDB.OpenRecordset ("tblPeople")
lngRSCount = RS.RecordCount
If lngRSCount = 0 Then
MsgBox "No email messages to send.", vbInformation
Else
RS.MoveLast
RS.MoveFirst

Do Until RS.EOF
strTo = RS!EmailAddress ‘This is the email field in tblPeople

DoCmd.SendObject objecttype:=acSendReport, _
ObjectName:=strDocName, outputformat:=acFormatRTF, _
To:=strTo

RS.Edit
RS.Update
RS.MoveNext
Loop
End If

RS.Close
MyDB.Close
Set RS = Nothing
Set MyDB = Nothing
Close

Exit Sub
End Sub

 

[Douglas J. Steele]

Private Sub cmdEmail_Click()

Dim strDocName As String
Dim strTo As String
0Dim varItem As Variant

strDocName = Me.lstRpt

DoCmd.RunCommand acCmdSaveRecord

If Me!MyListBox.ItemsSelected.Count = 0 Then
MsgBox "No email messages to send.", vbInformation
Else
For Each varItem In Me!MyListBox.ItemsSelected
strTo = Me!MyListBox.ItemData(varItem)
DoCmd.SendObject objecttype:=acSendReport, _
ObjectName:=strDocName, outputformat:=acFormatRTF, _
To:=strTo
Next varItem
End If

Exit Sub
End Sub

 

[Ken Sheridan]

Kurt:

Try this. It assumes the list box of email addresses is named
lstEmailAddresses and that you are still getting the report name from the
lstRpt list box on the same form.

Dim strDocName As String
Dim strTo As String
Dim varItem As Variant
Dim ctrl As Control

Set ctrl = Me.lstEmailAddresses
strDocName = Me.lstRpt

If Not IsNull(Me.lstRpt) Then
If ctrl.ItemsSelected.Count > 0 Then
For Each varItem In ctrl.ItemsSelected

strTo = ctrl.ItemData(varItem)

DoCmd.SendObject objecttype:=acSendReport, _
ObjectName:=strDocName, outputformat:=acFormatRTF, _
To:=strTo
Next varItem
Else
MsgBox "No addresses selected.", vbExclamation, "Warning"
End If
Else
"No report selected.", vbExclamation, "Warning"
End If

What this does is loop through the ItemsSelected collection of the list box.
This is a collection of variants each of which identifies the row selected
in the list. This can then be used as the index for the control's ItemData
property to return the value in the bound column of the row.

Ken Sheridan
Stafford, England