M
mason.bancroft
Hi there!
I have this Excel Macros which is designed to send an attachment to
someone's e-mail address. 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 corresponding e-mail address;
each cell in column B contains one e-mail address. The code below
works just fine for that.
Unfortunately, there may be more than one e-mail addresses 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 containing email address/
name
Do Until ActiveSheet.Cells(lRowCount, 2) = "" ' check for email,
End if none found
strEmail = ActiveSheet.Cells(lRowCount, 2).Value ' get email
address
strName = ActiveSheet.Cells(lRowCount, 1).Value ' get client name
Set objOutlookMsg = objOutlook.CreateItem(olMailItem) ' create
new email msg
With objOutlookMsg ' Fill email
.Subject = "Put this text in subject line" ' Note: Could be
column "C" - ActiveSheet.Cells(lRowCount, 3).Value
.Body = "Put this text in body of email" ' Note: Could be
column "D" - ActiveSheet.Cells(lRowCount, 4).Value
.To = strEmail
.Attachments.Add ("c:/e-mail attachments/" & strName & ".xls")
.Send
End With
lRowCount = lRowCount + 1 ' Increment Row Counter
Loop
objOutlook.Quit
Set objOutlook = Nothing
Set objOutlookMsg = Nothing
End Sub
I have this Excel Macros which is designed to send an attachment to
someone's e-mail address. 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 corresponding e-mail address;
each cell in column B contains one e-mail address. The code below
works just fine for that.
Unfortunately, there may be more than one e-mail addresses 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 containing email address/
name
Do Until ActiveSheet.Cells(lRowCount, 2) = "" ' check for email,
End if none found
strEmail = ActiveSheet.Cells(lRowCount, 2).Value ' get email
address
strName = ActiveSheet.Cells(lRowCount, 1).Value ' get client name
Set objOutlookMsg = objOutlook.CreateItem(olMailItem) ' create
new email msg
With objOutlookMsg ' Fill email
.Subject = "Put this text in subject line" ' Note: Could be
column "C" - ActiveSheet.Cells(lRowCount, 3).Value
.Body = "Put this text in body of email" ' Note: Could be
column "D" - ActiveSheet.Cells(lRowCount, 4).Value
.To = strEmail
.Attachments.Add ("c:/e-mail attachments/" & strName & ".xls")
.Send
End With
lRowCount = lRowCount + 1 ' Increment Row Counter
Loop
objOutlook.Quit
Set objOutlook = Nothing
Set objOutlookMsg = Nothing
End Sub