JasonEnsor
Programmer
Hi Guys,
I am trying to automate sending generic emails to students from an excel spreadsheet. I can generate an email for each student easily using a template, i can populate the subject field and to and from field as needed. However i can not fathom how to actually get data in to bookmarks set in the template. The current method i am using is replacing placeholders on the template, which works to a degree, however it messes up the formatting of my email template.
My Current code is
When i run this my placeholders are replaced but the email has :
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<HTML>
<HEAD>
Then Hyperlinks apear like HYPERLINK "mailto:test@test.co.uk"test@test.co.uk
Any help would be appreciated.
Jason
I am trying to automate sending generic emails to students from an excel spreadsheet. I can generate an email for each student easily using a template, i can populate the subject field and to and from field as needed. However i can not fathom how to actually get data in to bookmarks set in the template. The current method i am using is replacing placeholders on the template, which works to a degree, however it messes up the formatting of my email template.
My Current code is
Code:
Sub SendEmail()
Dim OutlookApp As Object
Dim MItem As Object
Dim cell As Range
Dim Subj As String
Dim p1 As Long, p2 As Long
Dim first_nameP As String
Dim last_nameP As String
Dim idP As String
Dim catalogP As String
Dim descr1P As String
Dim first_name As String
Dim last_name As String
Dim id As String
Dim catalog As String
Dim descr1 As String
first_nameP = "**First_Name**"
last_nameP = "**Last**"
idP = "**ID**"
catalogP = "**Catalog**"
descr1P = "**Descr1**"
Set OutlookApp = CreateObject("Outlook.Application")
Dim oItem As Object
For Each cell In Columns("H").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "*@*" Then
descr1 = cell.Offset(0, 2).Value
catalog = cell.Offset(0, -4).Value
first_name = cell.Offset(0, -5).Value
last_name = cell.Offset(0, -6).Value
id = cell.Offset(0, -7).Value
Subj = id & " - Subject Text" & " " & catalog
EmailAddress = cell.Value
Set oItem = OutlookApp.CreateItemFromTemplate("Template.oft")
p1 = InStr(oItem.Body, first_nameP)
If p1 > 0 Then
p2 = p1 + Len(last_nameP)
oItem.Body = Left(oItem.Body, p1 - 1) & last_name & Mid(oItem.Body, p2)
End If
p1 = InStr(oItem.Body, last_nameP)
If p1 > 0 Then
p2 = p1 + Len(last_nameP)
oItem.Body = Left(oItem.Body, p1 - 1) & last_name & Mid(oItem.Body, p2)
End If
p1 = InStr(oItem.Body, idP)
If p1 > 0 Then
p2 = p1 + Len(idP)
oItem.Body = Left(oItem.HTMLBody, p1 - 1) & id & Mid(oItem.Body, p2)
End If
p1 = InStr(oItem.Body, catalogP)
If p1 > 0 Then
p2 = p1 + Len(catalogP)
oItem.Body = Left(oItem.Body, p1 - 1) & catalog & Mid(oItem.Body, p2)
End If
p1 = InStr(oItem.Body, descr1P)
If p1 > 0 Then
p2 = p1 + Len(descr1P)
oItem.Body = Left(oItem.Body, p1 - 1) & descr1 & Mid(oItem.Body, p2)
End If
oItem.SentOnBehalfOfName = "Sender Name"
oItem.To = EmailAddress
oItem.Subject = Subj
oItem.Display
End If
Next
End SubWhen i run this my placeholders are replaced but the email has :
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<HTML>
<HEAD>
Then Hyperlinks apear like HYPERLINK "mailto:test@test.co.uk"test@test.co.uk
Any help would be appreciated.
Jason
