Sending multiple emails at same time in Excel
 

I have this code below that sends an email using outlook 2003 to a list of
email addresses I have referenced elsewhere in excel row by row. The trouble
I have is it sends the email sperately to each person on that list one by one
rather than sending it to them all together. How can I change this. Thanks.
Code is below.

Function emailMethod(EMailSendTo$, EMailSubject$, EMailAttachment$)
' Sending emails with Outlook

Dim objOutlook As Object
Dim objMailMessage As Outlook.MailItem
Dim emlBody, sendTo As String
Dim wkbook As String


Application.ScreenUpdating = False

Set objOutlook = CreateObject("Outlook.Application")
Set objMailMessage = objOutlook.CreateItem(0)
sendTo = EMailSendTo
wkbook = EMailAttachment

With objMailMessage
..To = ""
..BCC = sendTo
..Subject = EMailSubject
..Attachments.Add wkbook, olByValue
..Display


Application.Wait (Now + TimeValue("0:00:01"))
Application.ScreenUpdating = False

Application.SendKeys "%S"
Application.ScreenUpdating = False


End With
Set objOutlook = Nothing
Set objMailMessage = Nothing


Exit Function

End Function

Sending multiple emails at same time in Excel
 

See my mail page
http://www.rondebruin.nl/sendmail.htm

And look on the Tip page
http://www.rondebruin.nl/mail/tips2.htm


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"SD" wrote in message ...
I have this code below that sends an email using outlook 2003 to a list of
email addresses I have referenced elsewhere in excel row by row. The trouble
I have is it sends the email sperately to each person on that list one by one
rather than sending it to them all together. How can I change this. Thanks.
Code is below.

Function emailMethod(EMailSendTo$, EMailSubject$, EMailAttachment$)
' Sending emails with Outlook

Dim objOutlook As Object
Dim objMailMessage As Outlook.MailItem
Dim emlBody, sendTo As String
Dim wkbook As String


Application.ScreenUpdating = False

Set objOutlook = CreateObject("Outlook.Application")
Set objMailMessage = objOutlook.CreateItem(0)
sendTo = EMailSendTo
wkbook = EMailAttachment

With objMailMessage
.To = ""
.BCC = sendTo
.Subject = EMailSubject
.Attachments.Add wkbook, olByValue
.Display


Application.Wait (Now + TimeValue("0:00:01"))
Application.ScreenUpdating = False

Application.SendKeys "%S"
Application.ScreenUpdating = False


End With
Set objOutlook = Nothing
Set objMailMessage = Nothing


Exit Function

End Function