I have some code that fills an existing Outlook email template (with graphics!) with different variables i.e. name, ID number, etc. It works with both ".oft" and ".msg" templates stored on OneDrive. It's particularly fantastic when I can use "mailItem.Send" instead of "mailItem.Display" at the end. Which...I can only do when I trust the code.
Lately I've tried to alter the code so that it calls for 1 of 2 templates depending on a variable. But it often gives me Error 91 (object variable or with block variable not set) on "mailItem.Display" right after I call a template and it's driving me CRAZY.
PLEASE NOTE I'd rather do two "If - Then" statements than an "If - Then - Else" statement because there are 3 variable types and only 2 require email generation.
It worked fine for one variable type:
Do While Sheet1.Cells(r, 7) <> ""
'Call Outlook template
Set mailApp = CreateObject("Outlook.Application")
Set mailItem = mailApp.CreateItemFromTemplate("filepath\template.msg")
mailItem.Display
When I added the If statements below, the 91 error appeared on "mail.Item.Display":
Do While Sheet1.Cells(r, 7) <> ""
Set mailApp = CreateObject("Outlook.Application")
If Sheet1.Cells(r, 4) = "Type A" Then Set mailItem = mailApp.CreateItemFromTemplate("filepath\Atemplate.msg")
If Sheet1.Cells(r, 4) = "Tyep B" Then Set mailItem = mailApp.CreateItemFromTemplate("filepath\Btemplate.msg")
mailItem.Display <<<<<ERROR
Later in the code the If statements worked fine for different ".Subjects".
With mailItem
.Display
If Sheet1.Cells(r, 4) = "Type A" Or Sheet1.Cells(r, 4) = "Type B" Then .To = Toemail
If Sheet1.Cells(r, 4) = "Type A" Then .Subject = "Login Information for " + Firstname + " " + Lastname + "
If Sheet1.Cells(r, 4) = "Type B" Then .Subject = "Your other Information is ready - " + Firstname + " " + Lastname
What I Tried I tried just one If statement (and made sure that Type A was the top row in the Excel). No change.
I tried moving the EmpID = Sheet1.Cells... code chunk above Set mailApp.... No change.
I tried Removing "Set" from "Set mailItem" in both If statements. No change.
I tried moving the mailItem.Display to the end of each If statement, but the error moved down to my variables (EmpID...)
Do While Sheet1.Cells(r, 7) <> ""
Set mailApp = CreateObject("Outlook.Application")
If Sheet1.Cells(r, 4) = "Type A" Then Set mailItem = mailApp.CreateItemFromTemplate("filepath\Atemplate.msg") And mailItem.Display
If Sheet1.Cells(r, 4) = "Type B" Then Set mailItem = mailApp.CreateItemFromTemplate("filepath\Btemplate.msg") And mailItem.Display
EmpID = Sheet1.Cells(r, 1) <<<<<<ERROR
Lastname = Sheet1.Cells(r, 2)
Firstname = Sheet1.Cells(r, 3)
UserID = Sheet1.Cells(r, 5)
EmailID = Sheet1.Cells(r, 6)
Toemail = Sheet1.Cells(r, 7)
I tried setting Sheet1.Cells (r, 4) as a String variable Dim VariableType = String VariableType = Sheet1.Cells(r, 4) but that didn't help either.
Don't know if it's related but I could never get it to go r+1 for one variable. Tried:
VariableType = Sheet1.Cells(r, 4) If VariableType = "Type C" Then r = r + 1
and
If Sheet1.Cells(r, 4) = "Type C" Then r = r + 1
And neither worked.
Full code that works below:
Sub Send_email_from_template_my_code_1()
Dim EmpID As String
Dim Lastname As String
Dim Firstname As String
Dim VariableType As String
Dim UserID As String
Dim EmailID As String
Dim Toemail As String
Dim FromEmail As String
Dim mailApp As Object
Dim mailItem As Object
R=row number, and r = r + 1 will change the row number.
Dim r As Long
r = 2
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
VariableType = Sheet1.Cells(r, 4)
If VariableType = "Type C" Then r = r + 1
Do While Sheet1.Cells(r, 7) <> ""
'Call Outlook template
Set mailApp = CreateObject("Outlook.Application")
Set mailItem = mailApp.CreateItemFromTemplate("filepath\template.msg")
mailItem.Display
EmpID = Sheet1.Cells(r, 1)
Lastname = Sheet1.Cells(r, 2)
Firstname = Sheet1.Cells(r, 3)
UserID = Sheet1.Cells(r, 5)
EmailID = Sheet1.Cells(r, 6)
Toemail = Sheet1.Cells(r, 7)
With mailItem
.Display
If Sheet1.Cells(r, 4) = "Type A" Or Sheet1.Cells(r, 4) = "Type B" Then .To = Toemail
If Sheet1.Cells(r, 4) = "Type A" Then .Subject = "Login Information for " + Firstname + " " + Lastname + "
If Sheet1.Cells(r, 4) = "Type B" Then .Subject = "Your other Information is ready - " + Firstname + " " + Lastname
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
With oRng.Find
Do While .Execute(FindText:="[NAME]")
oRng.Text = Firstname + " " + Lastname
Loop
End With
Set oRng = wdDoc.Range
With oRng.Find
Do While .Execute(FindText:="[EmpID]")
oRng.Text = EmpID
Loop
End With
Set oRng = wdDoc.Range
With oRng.Find
Do While .Execute(FindText:="[EmailID]")
oRng.Text = EmailID
Loop
End With
Set oRng = wdDoc.Range
With oRng.Find
Do While .Execute(FindText:="[UserID]")
oRng.Text = UserID
Loop
End With
End With
mailItem.Display
r = r + 1
Loop
End Sub
Untested as I don't have Outlook
Option Explicit
Sub Send_email_from_template_my_code_1()
Dim EmpID As String, Lastname As String, Firstname As String
Dim VariableType As String, UserID As String
Dim EmailID As String, Toemail As String, FromEmail As String
Dim mailApp As Object, mailItem As Object
Set mailApp = CreateObject("Outlook.Application")
Dim olInsp As Object, wdDoc As Object, oRng As Object
Dim sText As String, r As Long, template As String
r = 2
Do While Sheet1.Cells(r, 7) <> ""
VariableType = Sheet1.Cells(r, 4)
If VariableType = "Type A" Then
template = "Atemplate.msg"
sText = "Login Information for "
ElseIf VariableType = "Type B" Then
template = "Btemplate.msg"
sText = "Your other Information is ready - "
Else
template = ""
End If
If template <> "" Then
With Sheet1
EmpID = .Cells(r, 1)
Lastname = .Cells(r, 2)
Firstname = .Cells(r, 3)
UserID = .Cells(r, 5)
EmailID = .Cells(r, 6)
Toemail = .Cells(r, 7)
End With
'Call Outlook template
Set mailItem = mailApp.CreateItemFromTemplate("filepath\" & template)
With mailItem
.To = Toemail
.Subject = sText & Firstname & " " & Lastname
.display
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
With oRng.Find
Do While .Execute(FindText:="[NAME]")
oRng.Text = Firstname & " " & Lastname
Loop
End With
Set oRng = wdDoc.Range
With oRng.Find
Do While .Execute(FindText:="[EmpID]")
oRng.Text = EmpID
Loop
End With
Set oRng = wdDoc.Range
With oRng.Find
Do While .Execute(FindText:="[EmailID]")
oRng.Text = EmailID
Loop
End With
Set oRng = wdDoc.Range
With oRng.Find
Do While .Execute(FindText:="[UserID]")
oRng.Text = UserID
Loop
End With
End With
End If
r = r + 1
Loop
Set mailApp = Nothing
End Sub