View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
[email protected] mason.bancroft@gmail.com is offline
external usenet poster
 
Posts: 2
Default Excel Macros sending attachments to multiple e-mail addressescontained in one cell.

On Jan 17, 10:52*pm, "Ron de Bruin" wrote:
Do you have duplicate rows with the same mail addresss in B ?
Am I understand you correct ?

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm



wrote in ...
Hi there!


I have thisExcelMacroswhich is designed to send an attachment to
someone'se-mailaddress. In this case, the title of the attachment is
identical to the name of the person to who I am sending it to.


My active worksheet only uses two ranges, A and B. *Down column A
lists the names of people; each cell in column A contains one person's
name. Down Column B lists each person's correspondinge-mailaddress;
each cell in column B contains onee-mailaddress. *The code below
works just fine for that.


Unfortunately, there may be more than onee-mailaddresses contained
in each B cell. *Any suggestions?


Sub SendEmailWithAttachment()
*Dim objOutlook As Outlook.Application
*Dim objOutlookMsg As Outlook.MailItem
*Dim strEmail As String, strName As String
*Dim lRowCount As Long


*Set objOutlook = CreateObject("outlook.application") *' Start
outlook


*lRowCount = 2 *' Change to starting ROW containingemailaddress/
name


*Do Until ActiveSheet.Cells(lRowCount, 2) = "" *' check foremail,
End if none found
* *strEmail = ActiveSheet.Cells(lRowCount, 2).Value *' getemail
address
* *strName = ActiveSheet.Cells(lRowCount, 1).Value *' get client name
* *Set objOutlookMsg = objOutlook.CreateItem(olMailItem) *' create
newemailmsg
* *With objOutlookMsg *' Fillemail


* * *.Subject = "Put this text in subject line" *' Note: Could be
column "C" - ActiveSheet.Cells(lRowCount, 3).Value
* * *.Body = "Put this text in body ofemail" *' Note: Could be
column "D" - ActiveSheet.Cells(lRowCount, 4).Value


* * *.To = strEmail
* * *.Attachments.Add ("c:/e-mailattachments/" & strName & ".xls")
* * *.Send
* *End With
* *lRowCount = lRowCount + 1 *' Increment Row Counter
*Loop


*objOutlook.Quit
*Set objOutlook = Nothing
*Set objOutlookMsg = Nothing
End Sub- Hide quoted text -


- Show quoted text -


I figured it out Ron. Sorry to waste your time. The code works just
fine. There could be more than one e-mail address in each b cell in
some circumstances. When I was running some tests, it seemed to work
if I did not use a hyper link (i.e., just had the e-mail address in
simple text) and used the semi colon ; to separate each e-mail address
contained in one B cell. If it doesn't work the next time I try, then
I'll leave a message again (but I think it will). Thanks again
Ron! :)