Copy a string of email addresses from Excel into Outlook TO: box

[RichardSaint]

The macro I'm using to copy a worksheet to the body of an Outlook email is working fine. Now I want to go to the worksheet ("volunteer list") and copy the email addresses in column D if the value of column A has an X in it then place that group of addresses in the TO: box of Outlook. Could you please show me where to place that code in the example below. Thank you.

Sub Mail_Selection_Range_Outlook_Body()<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
' Don't forget to copy the function RangetoHTML in the module.<o></o>
' Working in Office 2000-2010<o></o>
Dim rng As Range<o></o>
Dim OutApp As Object<o></o>
Dim OutMail As Object<o></o>
<o></o>
Set rng = Nothing<o></o>
On Error Resume Next<o></o>
'Only the visible cells in the selection<o></o>
'Set rng = Selection.SpecialCells(xlCellTypeVisible)<o></o>
'You can also use a range if you want<o></o>
Set rng = Sheets("Final Order of Service").Range("A1:B75").SpecialCells(xlCellTypeVisible)<o></o>
On Error GoTo 0<o></o>
<o></o>
If rng Is Nothing Then<o></o>
MsgBox "The selection is not a range or the sheet is protected" & _<o></o>
vbNewLine & "please correct and try again.", vbOKOnly<o></o>
Exit Sub<o></o>
End If<o></o>
<o></o>
With Application<o></o>
.EnableEvents = False<o></o>
.ScreenUpdating = False<o></o>
End With<o></o>
<o></o>
Set OutApp = CreateObject("Outlook.Application")<o></o>
Set OutMail = OutApp.CreateItem(0)<o></o>
<o></o>
On Error Resume Next<o></o>
With OutMail<o></o>
.To = ""<o></o>
.CC = ""<o></o>
.BCC = ""<o></o>
.Subject = "Order of Service"<o></o>
.HTMLBody = RangetoHTML(rng)<o></o>
.Display<o></o>
End With<o></o>
On Error GoTo 0<o></o>
<o></o>
With Application<o></o>
.EnableEvents = True<o></o>
.ScreenUpdating = True<o></o>
End With<o></o>
<o></o>
Set OutMail = Nothing<o></o>
Set OutApp = Nothing<o></o>
End Sub<o></o>
<o></o>
Function RangetoHTML(rng As Range)<o></o>
' Changed by Ron de Bruin 28-Oct-2006<o></o>
' Working in Office 2000-2010<o></o>
Dim fso As Object<o></o>
Dim ts As Object<o></o>
Dim TempFile As String<o></o>
Dim TempWB As Workbook<o></o>
<o></o>
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"<o></o>
<o></o>
'Copy the range and create a new workbook to past the data in<o></o>
rng.Copy<o></o>
Set TempWB = Workbooks.Add(1)<o></o>
With TempWB.Sheets(1)<o></o>
.Cells(1).PasteSpecial Paste:=8<o></o>
.Cells(1).PasteSpecial xlPasteValues, , False, False<o></o>
.Cells(1).PasteSpecial xlPasteFormats, , False, False<o></o>
.Cells(1).Select<o></o>
Application.CutCopyMode = False<o></o>
On Error Resume Next<o></o>
.DrawingObjects.Visible = True<o></o>
.DrawingObjects.Delete<o></o>
On Error GoTo 0<o></o>
End With<o></o>
<o></o>
'Publish the sheet to a htm file<o></o>
With TempWB.PublishObjects.Add( _<o></o>
SourceType:=xlSourceRange, _<o></o>
Filename:=TempFile, _<o></o>
Sheet:=TempWB.Sheets(1).Name, _<o></o>
Source:=TempWB.Sheets(1).UsedRange.Address, _<o></o>
HtmlType:=xlHtmlStatic)<o></o>
.Publish (True)<o></o>
End With<o></o>
<o></o>
'Read all data from the htm file into RangetoHTML<o></o>
Set fso = CreateObject("Scripting.FileSystemObject")<o></o>
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)<o></o>
RangetoHTML = ts.ReadAll<o></o>
ts.Close<o></o>
RangetoHTML = Replace(RangetoHTML, "align=center xublishsource=", _<o></o>
"align=left xublishsource=")<o></o>
<o></o>
'Close TempWB<o></o>
TempWB.Close savechanges:=False<o></o>
<o></o>
'Delete the htm file we used in this function<o></o>
Kill TempFile<o></o>
<o></o>
Set ts = Nothing<o></o>
Set fso = Nothing<o></o>
Set TempWB = Nothing<o></o>
End Function<o></o>
<!-- / message -->

 

[JP2112]

Welcome to the forum. Please wrap your VBA code in tags like this:

[code]
... your code goes here ...
[/code]


The line of code that specifies the recipients is this:

.To = ""

You would need a function that grabs the email addresses from the worksheet, concatenates them using ";" or "," (depending on your Outlook settings, ";" is safest if you don't know) and returns them to the calling procedure. Then you would call your function and assign its return value to the line of code above. ex:

.To = GetEmailAddresses

Assuming your function was named "GetEmailAddresses".

 

[RichardSaint]

Thank you. I tried some code from other applications and finally worked it out.