excelvbaoutlookemail-templates

Call one of two templates depending on a variable


I have code that fills an Outlook email template with different variables. e.g. name, ID number, etc.
It works with both ".oft" and ".msg" templates stored on OneDrive.

I tried to alter the code so that it calls one of two templates depending on a variable.
It often gives me

Error 91 object variable or with block variable not set

on mailItem.Display right after I call a template.

Note: I'd rather do two "If - Then" statements than an "If - Then - Else" statement because there are three variable types and only two require email generation.

It worked 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, 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 work 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

I tried just one If statement (and made sure that Type A was the top row in 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).

If it's related, 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

Full code that works:

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

Solution

  • You already got a suggestion but I'd also add this.

    You can create a sub to do the find and replace

    'Replace text `placeHolder` with `txt` in Word Range `rng`
    Sub ReplaceRangeText(rng As Object, placeHolder As String, txt As String)
        With rng.Find
            Do While .Execute(FindText:=placeHolder)
                rng.Text = txt
            Loop
        End With
    End Sub
    

    Then you can do (eg):

        With mailApp.CreateItemFromTemplate(templatePath)
            .Display
            .Subject = Subj
            .To = rw.Cells(7).Value
                
            Set wdDoc = .GetInspector.WordEditor
            ReplaceRangeText wdDoc.Range, "[NAME]", FullName
            ReplaceRangeText wdDoc.Range, "[EmpID]", rw.Cells(1).Value   'EmpID
            ReplaceRangeText wdDoc.Range, "[EmailID]", rw.Cells(6).Value 'EmailID
            ReplaceRangeText wdDoc.Range, "[UserID]", rw.Cells(5).Value  'UserID
        End With