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

RichardSaint · May 2, 2012

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

ffice

ffice" /><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 x

ublishsource=", _<o

></o

>
"align=left x

ublishsource=")<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

>

JP2112 · May 8, 2012

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:

Code:

.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:

Code:

.To = GetEmailAddresses

Assuming your function was named "GetEmailAddresses".

RichardSaint · May 8, 2012

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

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

RichardSaint

New Member

JP2112

Board Regular

RichardSaint

New Member

Similar threads

Share this page

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

RichardSaint

New Member

JP2112

Board Regular

RichardSaint

New Member

Similar threads

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock