Email contents of ListBox

[JimLes]

I would like to take the contents of a multi-selection listbox and put them into the body of an email message. I found the following code but it does not work for me:

My list box has 7 columns that I would like to grab the first 6 in the email body.

Any help is greatly appreciated!


Private Sub EEList_DblClick(Cancel As Integer)
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim ctl As Control
Dim str As String
Dim varItem As Variant

Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)

Set ctl = Me.EEList

For Each varItem In ctl.ItemsSelected
str = str & ctl.ItemData(varItem) & ", " & vbCrLf
Next varItem

str = Left$(str, Len(str) - 3)
str = str & ")"

With MailOutLook
.BodyFormat = olFormatRichText
.To = ""
.Subject = "Employee(s) to be Termed"
.HTMLBody = str & Chr(13) & Me.typetext & Chr(13)
.Display (True)
End With
'MsgBox MailOutLook.Body
Exit Function
email_error:
MsgBox "An error was encountered." & vbCrLf & "The error message is: " & Err.Description
Resume Error_out
Error_out:

End Sub

 

[JimLes]

Okay, I have tweaked the code to get me to the email, however, it only retrieves the first column which is bound. Any ideas to get the other 6 columns to pull in?

Thanks,

Private Sub EEList_DblClick(Cancel As Integer)
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim oItem As Variant
Dim sTemp As String
Dim iCount As Integer

iCount = 0

Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)

If Me!EEList.ItemsSelected.Count <> 0 Then
For Each oItem In Me!EEList.ItemsSelected
If iCount = 0 Then
sTemp = sTemp & Me!EEList.ItemData(oItem)
iCount = iCount + 1
Else
sTemp = sTemp & "," & Me!EEList.ItemData(oItem)
iCount = iCount + 1
End If
Next oItem
Else
MsgBox "Nothing was selected from the list", vbInformation
Exit Sub 'Nothing was selected
End If

With MailOutLook
.BodyFormat = olFormatRichText
.To = ""
.Subject = "Employee(s) to be Termed"
.HTMLBody = sTemp
.Display (True)
End With


End Sub

 

[JimLes]

SOLVED

This code will pull the data from a multi-selection listbox from the bound column 0 along with columns 1 and 5 into the body of an email message. I used the HTML code "<br />" to line break the data to a new row.


Private Sub Command596_Click()
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim oItem As Variant
Dim sTemp As String
Dim iCount As Integer

iCount = 0

Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)

If Me!EEList.ItemsSelected.Count <> 0 Then
For Each oItem In Me!EEList.ItemsSelected
If iCount = 0 Then
sTemp = sTemp & "<br />" & Me!EEList.ItemData(oItem)
sTemp = sTemp & " " & Me!EEList.Column(1, oItem)
sTemp = sTemp & " " & Me!EEList.Column(5, oItem)


Else
sTemp = sTemp & "<br />" & Me!EEList.ItemData(oItem)
sTemp2 = sTemp & " " & Me!EEList.Column(1, oItem)
sTemp = sTemp & " " & Me!EEList.Column(5, oItem)
iCount = iCount + 1
End If
Next oItem
Else
MsgBox "Nothing was selected from the list", vbInformation
Exit Sub 'Nothing was selected
End If

With MailOutLook
.BodyFormat = olFormatRichText
.To = ""
.Subject = "Employee(s) to be Termed"
.HTMLBody = sTemp
.Display (True)
End With


End Sub