PDA

View Full Version : VBA email - MERGE addresses



C2Code
05-17-2012, 09:58 AM
Hey, so am a little green when it comes to coding. I found some existing code and tweaked it a bit, but I cannot get the macro to compose ONE email with all the addresses selected into the BCC. Any leads, advice or help?

Instead this macro creates an email for each address selected:


Private Sub CommandButton1_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("H").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "G").Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing

Application.ScreenUpdating = True
End Sub

:dunno
Thanks for any help given!

Bob Phillips
05-17-2012, 10:03 AM
Selected from where? Should the first email address go to To, the rest to Bcc?

snb
05-17-2012, 12:54 PM
Private Sub CommandButton1_Click()
with CreateObject("Outlook.Application").CreateItem(0)
.subject="onderwerp"
.to="me@google.com"
.bcc= join(application.transpose(Columns(8).SpecialCells(2)),",")
.Send
End With
End Sub

GTO
05-17-2012, 12:59 PM
...I cannot get the macro to compose ONE email with all the addresses selected into the BCC....

Greetings C2Code,

Just a "practice throw" if you will, but in essence, I think you will want to build the string of addresses in your loop, then just create one message.

Option Explicit

Private Sub CommandButton1_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strAddresses As String

On Error GoTo cleanup
For Each cell In Columns("H").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "G").Value) = "yes" Then

strAddresses = strAddresses & cell.Text & "; "

End If
Next cell

strAddresses = Trim(strAddresses)


If Len(strAddresses) > 0 Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = strAddresses
.Display
End With
Else
Exit Sub
End If

cleanup:
Set OutMail = Nothing
Set OutApp = Nothing
End Sub


Does that help?

Mark

EDIT: Okay, a mis-throw.... here's a "do over"