Copy a column from excel and paste in the "To" section of a new email in Outlook

[Brr]

Hi VBA Express users,

I am new to the forum and to VBA and excel.

I am completely stumped on this one last feature I am trying to implement in a macro I have created.

Basically the macro I have created will sort and filter large data tables and put the relevant results infront of the user.

A column of these results is a list of email addresses based on the search.

I am trying to create some VBA code to copy the column (AA) from Sheet2 of email addresses and then create a new email in outlook and paste the list from column AA in the "To" section of the new email.

I can not find any code to adapt my needs to do this :(

I have tried using the code from this super helpful site called Ron de Bruin Excel Automation. (I'd post the link but I don't have enough posts yet :( )

Except when I adjust the code to use range AA and paste it into the To section of the email. Since the code from that site converts the copied data to HTML code, it pastes the HTLM code into the To section of the email, not the email addresses :(

If i use the range to be the body of the email, the code works fine. But this is not what I am trying to achieve.

Any help would be greatly appreciated!!!

Thank you :)

Kind Regards VBA Noob

[Brr]

This is the VBA code I have been trying to use from Ron De Bruins webpage:

Sub Mail_Selection_Range_Outlook_Body()


Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object


Set rng = Nothing
' Only send the visible cells in the selection.


Set rng = Sheets("Sheet1").Range("D4:D12").SpecialCells(xlCellTypeVisible)


If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected. " & _
vbNewLine & "Please correct and try again.", vbOKOnly
Exit Sub
End If


With Application
.EnableEvents = False
.ScreenUpdating = False
End With


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)




With OutMail
.To = ThisWorkbook.Sheets("Sheet2").Range("AA1").Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = RangetoHTML(rng)
' In place of the following statement, you can use ".Display" to
' display the e-mail message.
.Display
End With
On Error GoTo 0


With Application
.EnableEvents = True
.ScreenUpdating = True
End With


Set OutMail = Nothing
Set OutApp = Nothing
End Sub




Function RangetoHTML(rng As Range)
' By Ron de Bruin.
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook


TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"


'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With


'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With


'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")


'Close TempWB
TempWB.Close savechanges:=False


'Delete the htm file we used in this function
Kill TempFile


Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function




What I have highlighted in red is where I am stuck. I want to copy from the AA column the list of emails and paste them into the "To" section of the new email. The AA column could be from AA1 to AA50 after one search or AA1 to AA13 after another. So only copying the column that has data and ignoring blanks cells further down would be ideal. Unfortunately when I try to expand the range to more then one cell the code bugs out :( If i try to convert the data to html format like the body section of the code it wont paste properly.

Can anyone point me in the right direction? or is this not possible?

Kind Regards

[p45cal]

direction pointing only:
With ThisWorkbook.Sheets("Sheet2")
Recipients = Join(Application.Transpose(.Range(.Cells(1, "AA"), .Cells(.Rows.Count, "AA").End(xlUp)).Value), ";")
End With
With OutMail
.To = Recipients
.CC = ""

or, (not recommended) just:

.To = Join(Application.Transpose(ThisWorkbook.Sheets("Sheet2").Range(ThisWorkbook.Sheets("Sheet2").Cells(1, "AA"), ThisWorkbook.Sheets("Sheet2").Cells(ThisWorkbook.Sheets("Sheet2").Rows.Count, "AA").End(xlUp)).Value), ";")

[Brr]

Thank you p45cal!!!

This is exactly what I was after. I spent a week googling and looking around for this answer! I really appreciate your response.

I could not work out how to get the "direction pointing only" code to work. But you "not recommended" code worked perfectly!

I can finally finish off my macro :)

Where did you source your answers from? Just to help me in future when I become stuck?

Or just able to answer from experience? I have only been using VBA for 3 weeks :)

Thanks again ^_^

[p45cal]

Where did you source your answers from? Just to help me in future when I become stuck?
Or just able to answer from experience?The latter.

[Brr]

Awesome :)

Thanks again ^_^