Issue with multiple select email list box to send to outlook

Mitchell G

New member
Local time
Tomorrow, 00:57
Joined
Feb 1, 2016
Messages
2
Hi guys

I have a form set up in Access that users can enter details into for a site visit to a client. My intention is to have a calendar meeting invite sent to Outlook for the people who need to attend these site visits.

There is a list box on the form with multiple select and users can choose the people that need to attend. (this can be 1 or it can be multiple). Second column in the list box contains the email address.

The code I have is working if just one person on the list is selected, however when multiple people are selected it doesn't work and is erroring on the .send with "The operation failed. An object cannot be found"

Code is posted below. I have been wracking on head on this the past 2 days. Any help would be greatly appreciated.

Thanks



Private Sub SendOutlook_Click()

Dim oApp As Outlook.Application
Dim oItm As Outlook.AppointmentItem
Set oApp = CreateObject("Outlook.Application")
Set oItem = oApp.CreateItem(olAppointmentItem)

Dim ctl As ListBox
Dim varItm As Variant
Dim listOfMails As String

With oItem
.MeetingStatus = olMeeting
.Start = Me!ApptStartDate & " " & Me!ApptTimeStart
.Duration = Me!Length4
.BusyStatus = olFree
.Subject = "Site Visit - " & Me![Planned Consultant] & ": " & Me![Client]
.Body = _
"Consultant: " & Me![Planned Consultant] & vbCrLf & _
"Start Date: " & Me![ApptStartDate] & " Start Time: " & Me![ApptTimeStart] & vbCrLf & _
"End Date: " & Me![ApptEndDate] & " End Time: " & Me![ApptTimeEnd] & vbCrLf & _
"Location: " & Me![SiteLocation] & ", State: " & Me![PlannedState] & vbCrLf & _
"Number of Attendees: " & Me![PlannedAttendees] & vbCrLf & _
"Notes: " & Me![Planned Notes]


listOfMails = ""

Set ctl = Me!
[List1]

If ctl.ItemsSelected.Count < 1 Then Exit Sub

For Each varItm In ctl.ItemsSelected

listOfMails = listOfMails & ctl.Column(1, varItm) & ";"

Next varItm

listOfMails = Left$(listOfMails, Len(listOfMails) - 1)

.Recipients.Add listOfMails

.Save

.Send

End With

Exit Sub

End Sub
 
Private Sub SendOutlook_Click()

Dim oApp As Outlook.Application
Dim oItm As Outlook.AppointmentItem
Set oApp = CreateObject("Outlook.Application")
Set oItem = oApp.CreateItem(olAppointmentItem)

Dim ctl As ListBox
Dim varItm As Variant
Dim listOfMails As String

With oItem
.MeetingStatus = olMeeting
.Start = Me!ApptStartDate & " " & Me!ApptTimeStart
.Duration = Me!Length4
.BusyStatus = olFree
.Subject = "Site Visit - " & Me![Planned Consultant] & ": " & Me![Client]
.Body = _
"Consultant: " & Me![Planned Consultant] & vbCrLf & _
"Start Date: " & Me![ApptStartDate] & " Start Time: " & Me![ApptTimeStart] & vbCrLf & _
"End Date: " & Me![ApptEndDate] & " End Time: " & Me![ApptTimeEnd] & vbCrLf & _
"Location: " & Me![SiteLocation] & ", State: " & Me![PlannedState] & vbCrLf & _
"Number of Attendees: " & Me![PlannedAttendees] & vbCrLf & _
"Notes: " & Me![Planned Notes]


listOfMails = ""

Set ctl = Me!
[List1]

If ctl.ItemsSelected.Count < 1 Then Exit Sub

For Each varItm In ctl.ItemsSelected

'listOfMails = listOfMails & ctl.Column(1, varItm) & ";"
.Recipients.Add ctl.Column(1, varItm)
Next varItm

'listOfMails = Left$(listOfMails, Len(listOfMails) - 1)

'.Recipients.Add listOfMails

.Save

.Send

End With

Exit Sub

End Sub
 
Thanks very much arnelgp

It works now. Cheers
 

Users who are viewing this thread

Back
Top Bottom