Thread: Multiple email recipients from excel

Hi,

I have obtained the following code which works great apart from the fact that I want to just send one email to all addressees instead of multiple emails. Is there someone who could help modify it please;

Code:

Sub TestFile()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim strbody As String

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon

    On Error GoTo cleanup
    For Each cell In Range("G1:G20")
        strbody = strbody & cell.Value & vbNewLine
    Next
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "C").Value) = "yes" Then

            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .BCC = cell.Value
                .Subject = "Reminder"
                .Body = "Dear " & Cells(cell.Row, "A").Value & vbNewLine & vbNewLine & strbody
                'You can add files also like this
                '.Attachments.Add ("C:\test.txt")
                .Display  'Or use Send
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

I appreciate any help offered

Kind regards

Steve

Hi Steve,

Welcome to the forum.

Please note the forum rules about putting VBA code inside tags. As this is your first visit I have changed them for you this time.

Regards

Steve,

Try the following modified procedure.

Code:

Sub TestFile()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim strbody As String
    Dim stemails As String

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon

    On Error GoTo cleanup
    For Each cell In Range("G1:G20")
        strbody = strbody & cell.Value & vbNewLine
    Next
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "C").Value) = "yes" Then
            stemails = stemails & cell & ";"
        End If
    Next cell

    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .bcc = stemails
        .Subject = "Reminder"
        .Body = "Dear " & Cells(cell.Row, "A").Value & vbNewLine & vbNewLine & strbody
        'You can add files also like this
        '.Attachments.Add ("C:\test.txt")
        .Display    'Or use Send
    End With
    On Error GoTo 0
    Set OutMail = Nothing


cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

HTH

Try

Code:

Sub TestFile()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim strbody As String

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon

    On Error GoTo cleanup
    
    strbody = "This is the message"
    
    
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
            
   For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "C").Value) = "yes" Then
            OutMail.BCC = OutMail.BCC & ";" & cell.Value
        End If
  Next cell
  
With OutMail
    .Subject = "Reminder"
    .Body = "Dear everybody " & vbNewLine & vbNewLine & strbody
    'You can add files also like this
    '.Attachments.Add ("C:\test.txt")
    .Display  'Or use Send
End With
On Error GoTo 0
Set OutMail = Nothing
   

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Hi Steve,

Probably the easiest way is to add an object of some sort, an icon, picture, drawing object like a rectangle etc. and associate your TestFile macro with it. i.e. once you have the object on the sheet, right click it, choose 'Assign macro' and then select the TestFile macro.

Now whenever you click the object the macro will run.

You can of course also run it directly from the Menu, 'Developer > Macros if you're using 2007, or Tools > Macro > Macros with 2003.

HTH

Hi,

What exactly is the Body content? Presumably the macro which contains "Dear Everybody" and "This is the message" is just an example. I'm assuming the real body is a paragraph of text in the workbook.

If so can you upload the actual workbook you're using?

Rgds

Hi Steve,

Please see the attached. Is this something along the lines of what you want. The macro to run is the 'CreateOutlookMessage'

Let me know