Macro to send e-mail from excel.

nianchi111

Board Regular
Joined
Aug 24, 2007
Messages
197
Office Version
  1. 365
Friends,

I want to send e-mail to 100 people.

e-mail address are in Column A

Body of the mail is in from B1:B10.

Can this be sent using Macro.

Please help me..

Thanks,
Nianchi111..
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
You could try this.

I use it for sending mail to several people where I modify the message in the 'Messages' sheet and use a list of contacts in the 'Contacts' sheet.
Note the Subject of the email is also from a cell.
.send is commented out - to test and view.



This sends the same email to everyone in the list. If you want an email each it will require modifying slightly.

Code:
Sub Message100()
Dim OutApp As Object
Dim OutMail As Object
Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
 
Sheets("Messages").Activate
'Subject string
    EmailSubject = Sheets("Messages").Range("G6").Value 
 
 
    For i = 1 To 100
    If Sheets("Contacts").Range("A1").Value <> "" Then
    nameList = nameList & ";" & Sheets("Contacts").Range("A" & i).Value
    EmailSendTo = nameList
    End If
 
Next
 
'Message create
    For Each Cell In Sheets("Messages").Range("B1:B10")
        MailBody = MailBody & Cell.Value & vbCr
    Next
 
'Send Mail
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(o)
        With OutMail
            .Subject = EmailSubject
            .To = EmailSendTo
           ' .bcc = Sheets("Messages").Range("G5").Value   
            .Body = MailBody
            .Display
            '.send 
        End With
 
        Set OutMail = Nothing
        Set OutApp = Nothing
 
 
End Sub
 
Last edited:
Upvote 0
Modified so each contact gets a separate mail.

Code:
Sub Message100()
Dim OutApp As Object
Dim OutMail As Object
Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
 
'Subject string
EmailSubject = Sheets("Messages").Range("G6").Value
Sheets("Contacts").Activate
Range("A1").Select
 
Do While ActiveCell.Value <> ""
EmailSendTo = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
 
 
'Message create
For Each Cell In Sheets("Messages").Range("B1:B10")
MailBody = MailBody & Cell.Value & vbCr
Next
 
'Send Mail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(o)
With OutMail
.Subject = EmailSubject
.To = EmailSendTo
'.bcc = Sheets("Messages").Range("G5").Value
.Body = MailBody
.Display
'.send
End With
 
Set OutMail = Nothing
Set OutApp = Nothing
MailBody = ""
Loop
End Sub
 
Upvote 0
Just wanted to add my thanks for this help. The coding provided by daverunt worked beautifully.
 
Upvote 0
This MACRO works great! How can it be adjusted to include list unto Bcc field in Outlook email rather than To field?? Please advise.


JP
 
Upvote 0
Just when I thought I had it all figured out (and I did!), I am stuck!??

I am using Ron Debruin's code he provided on his site and a simple message works just fine. However, I decided to modify to a different message within Excel. This message contains date and time formulas within the range.

The issue I am running into is that Outlook breaks the message completely and does not carryover the format of the formula as displayed in Excel.
For example:

(Excel, Y5:AH20)
As of December 1, 2011 11:48PM [Y6, =NOW()] blah blah blah November 24, 2011 [AH6, =TODAY()] blah blah.

(Outlook displays the message)
As of
12/01/11
blah blah blah blah
11/24/11
blah blah

Below is the MACRO if anyone in the VBA community can assist me with:

Sub Send_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim EmailSubject As String
Dim EmailBcc As String
Dim MailBody As String

Sheets("First_Run").Activate
'Subject string
EmailSubject = Sheets("First_Run").Range("Y3").Value


For i = 1 To 1000
If Sheets("1200_Run").Range("E2").Value <> "" Then
nameList = nameList & ";" & Sheets("1200_Run").Range("E" & i).Value
EmailBcc = nameList
End If

Next

'Message create
For Each Cell In Sheets("First_Run").Range("Y5:AH20")
MailBody = MailBody & Cell.Value & vbCr
Next

'Send Mail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(o)
With OutMail
.Subject = EmailSubject
.To = Sheets("First_Run").Range("Y1").Value
.bcc = EmailBcc
.Body = MailBody
.Display
'.send
End With

Set OutMail = Nothing
Set OutApp = Nothing


End Sub


I greatly appreciate any type of assistance. Thanks in advance!

JP
 
Upvote 0

Forum statistics

Threads
1,225,149
Messages
6,183,177
Members
453,151
Latest member
Lizamaison

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top