jenrique.cerda
Board Regular
- Joined
- Sep 22, 2006
- Messages
- 53
Hi, I now know how to send a personalized e-mail. I know this but this sends one e-mail to each person instead of sending one e-mail to lots of them... can anyone help me to send just one e-mail?
The code for this is:
Sub SendEmail()
Dim OutlookApp As Object
Dim MItem As Object
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Recipient As String
Dim Bonus As String
Dim Msg As String
'Create Outlook object
Set OutlookApp = CreateObject("Outlook.Application")
'Loop through the rows
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "*@*" Then
'Get the data
Subj = "Your Annual Bonus"
Recipient = cell.Offset(0, -1).Value
EmailAddr = cell.Value
Bonus = Format(cell.Offset(0, 1).Value, "$0,000.")
'Compose message
Msg = "Dear " & Recipient & vbCrLf & vbCrLf
Msg = Msg & "I am pleased to inform you that "
Msg = Msg & "your annual bonus is "
Msg = Msg & Bonus & vbCrLf & vbCrLf
Msg = Msg & "William Rose" & vbCrLf
Msg = Msg & "President"
'Create Mail Item and send it
Set MItem = OutlookApp.CreateItem(0)
With MItem
.To = EmailAddr
.Subject = Subj
.Body = Msg
.Display
'NOTE: To actually send the emails, use .Send instead of .Display
'.Send
End With
End If
Next
End Sub
The code for this is:
Sub SendEmail()
Dim OutlookApp As Object
Dim MItem As Object
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Recipient As String
Dim Bonus As String
Dim Msg As String
'Create Outlook object
Set OutlookApp = CreateObject("Outlook.Application")
'Loop through the rows
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "*@*" Then
'Get the data
Subj = "Your Annual Bonus"
Recipient = cell.Offset(0, -1).Value
EmailAddr = cell.Value
Bonus = Format(cell.Offset(0, 1).Value, "$0,000.")
'Compose message
Msg = "Dear " & Recipient & vbCrLf & vbCrLf
Msg = Msg & "I am pleased to inform you that "
Msg = Msg & "your annual bonus is "
Msg = Msg & Bonus & vbCrLf & vbCrLf
Msg = Msg & "William Rose" & vbCrLf
Msg = Msg & "President"
'Create Mail Item and send it
Set MItem = OutlookApp.CreateItem(0)
With MItem
.To = EmailAddr
.Subject = Subj
.Body = Msg
.Display
'NOTE: To actually send the emails, use .Send instead of .Display
'.Send
End With
End If
Next
End Sub