Send Outlook Emails via Excel

[tommychowdah]

Hi Everyone,

I am trying to send out outlook emails via an excel spreadsheet. Below is the code I am currently using. I have a table with the individual's name, email address, and business as well as a subject line and CC column (example of the table is below). I also have a text box created where the Dear [Name] and Business [Name] is replaced with the column values. When I hit the macro button, the code runs through each row in the table and an email pops up in outlook. At this point, I was hoping to layer in some additional functionality and am curious if anyone has any suggestions. Any help is much appreciated.

1. Ability to reply to the last email sent or received for each individual in the table
2. Ability to delay send
3. Ability to drop in outlook signature
4. Ability to format hyperlinks

Name	Email	Subject	CC	Business
Tom	tom@tom.com	Sample Subject	bob@bob.com	123 Company
Jim	jim@jim.com	Sample Subject	tom@tom.com	ABC Company
Bob	bob@bob.com	Sample Subject	jim@jim.com	XYZ Company

Sub send_email()

Dim i As Integer
Dim name, email, body, subject, copy, place, business As String
Dim OutApp As Object
Dim OutMail As Object

body = ActiveSheet.TextBoxes("TextBox 1").Text

i = 2
'Loop down name column starting at row 2 column 1
Do While Cells(i, 1).Value <> ""

name = Split(Cells(i, 1).Value, " ")(0) 'extract first name
email = Cells(i, 2).Value
subject = Cells(i, 3).Value
copy = Cells(i, 4).Value
business = Cells(i, 5).Value

'replace place holders
body = Replace(body, "X1", name)
body = Replace(body, "X2", business)

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = email
.CC = copy
.subject = subject
.body = body
'.Attachments.Add ("") 'You can add files here
.Display '.Send
End With

'reset body text
body = ActiveSheet.TextBoxes("TextBox 1").Text

i = i + 1
Loop

Set OutMail = Nothing
Set OutApp = Nothing

End Sub