Reputation: 115
I have a slight issue with a macro. It works fine at the moment, but I need to add some code to do the following but don't know at what point to add it:
If for each cell in Column C that there is a blank cell to look for the email address on the same row but 10 columns over to the right in Column M
In the start of the body "Hi There (Column B content)
In the body of the email I would like for the macro to insert the contents from column F like this: "Please choose the following option (Column F content)
Any Ideas on how I can modify the code to include these options please.
Thank you for your time.
Sub Send_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim cel As Range
Dim SigString As String
Dim Signature As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
SigString = Environ("appdata") & _
"\Microsoft\Signatures\GBS.txt"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
For Each cel In Range(("C2"), Range("C2").End(xlDown))
strbody = "Hi there" & vbNewLine & vbNewLine & _
"My name Is William, Please choose the following option ..." & vbNewLine & _
"I work at Fair" & vbNewLine & _
"Bye" & vbNewLine & _
"WH"
On Error Resume Next
With OutMail
.To = cel.Value
.CC = cel.Offset(0, 10).Value
'.BCC = ""
.Subject = "Choose you plan"
.Body = strbody & vbNewLine & vbNewLine & Signature
.Display
'.Attachments.Add ("C:\test.txt")
'.Send
End With
On Error GoTo 0
Next cel
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Upvotes: 1
Views: 144
Reputation: 35853
Try this one:
Sub Send_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim cel As Range
Dim SigString As String
Dim Signature As String
Dim lastrow As Long
Set OutApp = CreateObject("Outlook.Application")
SigString = Environ("appdata") & _
"\Microsoft\Signatures\GBS.txt"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
lastrow = Cells(Rows.Count, 3).End(xlUp).Row
For Each cel In Range("C2:C" & lastrow)
strbody = "Hi there" & cel.Offset(, -1) & vbNewLine & vbNewLine & _
"My name Is William, Please choose the following option ..." & vbNewLine & _
cel.Offset(, 3) & _
"I work at Fair" & vbNewLine & _
"Bye" & vbNewLine & _
"WH"
On Error Resume Next
With OutApp.CreateItem(0)
If cel.Value <> "" Then
.To = cel.Value
.CC = cel.Offset(0, 10).Value
Else
.To = cel.Offset(0, 10).Value & ", " & Join(Application.Index(cel.Offset(, -2).Resize(, 4).Value, 0), ", ")
End If
'.BCC = ""
.Subject = "Choose you plan"
.Body = strbody & vbNewLine & vbNewLine & Signature
.Display
'.Attachments.Add ("C:\test.txt")
'.Send
End With
On Error GoTo 0
Next cel
Set OutApp = Nothing
End Sub
Upvotes: 3