Personalised Email Templates – VBA

0 Comments read Quick Fixes, Solutions

Are you sending the same email over and over again, with just a few alterations? I know I do, and one of the easiest ways is to open an oft template and then change some words.

Adding a Macro

You can use this post to see how to add macros, and how to enable a button for it:

Enabling Macros in Outlook

The Solution

This is a simple two part solution:

1. The Email Template

Which has [TARGET] words that will be replaced from questions that are asked by input boxes.

2. The VBA Macro

This will open the Macro, ask you some Inputs, and then replace the [TARGET] words with what you entered in the inputs.

The Template

This is the easy part, just build an email then opt to Save As the message, as a template (*.oft). This is the example of the one used by the code. You’ll see three uses of [Gift] and one of the [Gifter] target words.

I’ve used a word inside the square brackers [TARGET]

The Code

Theres a lot you can do here, but I’ve opted for the basics – targeting words in the subject line and the body of the message.

You run the Coffee_Thanks() as a Quick Access button, which for each replacement the script calls the replaceText() sub.

Sub Coffee_Thanks()
    
    '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-'
    '  VARIABLES  -------------------------------------------------------------------------------'
    '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-'
        'DATA----------------------------------------  
        Dim CoffeeAmount As String 
        Dim personName As String 
        'TEMPLATE------------------------------------ 
        Dim newItem As Outlook.MailItem  
        'REPLACEMENTS-------------------------------- 
        Dim wdDoc As Object 
        Dim olItem As Object 
        Dim olInsp As Outlook.inspector 
    '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-'




    '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-'
    '  GATHER INFO ------------------------------------------------------------------------------'
    '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-'
       ' Gather additional information-------------- 
        CoffeeAmount = InputBox("Coffee Gift in $:")    
        personName = InputBox("Recipients name:")
    '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-'
   
    
    
    
    '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-'
    '  OPEN TEMPLATE ----------------------------------------------------------------------------'
    '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-'
        ' open Template------------------------------  
        Set newItem = Application.CreateItemFromTemplate("D:\Templates\Outlook\Coffee_Thanks.oft")
        newItem.Display
    '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-'
    
    
    
    '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-'
    '  TEXT REPLACEMENTS ------------------------------------------------------------------------'
    '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-'
       ' Set up for changes-------------------------  
		   ' Word Swaps in Subject line-----------------  
				Set olInsp = Application.ActiveInspector  
				Set olItem = olInsp.currentItem  
			 ' Word swaps in Body--------------------------
				Set wdDoc = newItem.GetInspector.WordEditor 

		   ' Replace all placeholders-------------------   
        olItem.Subject = Replace(olItem.Subject, "[Gift]", CoffeeAmount) 
        Call replaceText(wdDoc, "[Gifter]", personName)
        Call replaceText(wdDoc, "[Gift]", CoffeeAmount)
    '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-'
    
End Sub

Sub replaceText(wdDoc As Object, findText As String, replaceText As String)
	'+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-'
    '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-'
    ' Repeatable loop to replace words in the body, without altering
    ' the HTML formatting.
	'+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-'
    With wdDoc.Content.Find
        .Text = findText
        .Replacement.Text = replaceText
        .Execute Replace:=2 ' 2 = Replace all
    End With
End Sub

NOTE: I’ve saved my oft template to “D:\Templates\Outlook\Coffee_Thanks.oft”, you will need to change the code to point to where ever you have saved the template.

There’s a mountain different ways to use this, and you can do various other things like:

  • Calculate the time of day to tweak the greating to a good morning, or afternoon.
  • Find out when the next weekend is, because you’re using this to warn about patching.
  • Add people to the CC or BC fields.
  • Use input choices to add different content.

Download the Code

WordReplacement.vb https://github.com/Works4Me-Info/Outlook-Macros

You May Also Like

Event Log Properties – PowerShell One of the best uses of PowerShell in my experience is auditing the Event ... Dynamic Menus – PowerShell When you’re writing a PowerShell script as a tool, you’ll ...

Leave A Comment

Your email address will not be published. Required fields are marked *