Microsoft Office Forums - View Single Post - Is there a way to automate information into emails?

gmayor · 01-21-2018, 10:34 PM

To show the principles involved, from Outlook, create a message that contains some text and four bookmarked locations bmTest1 to bmTest4. Save it as a template called 'Bookmark Test.oft'.

Then create the following macro in a new VBA module. Change the template path as appropriate. Then run the macro. It will create a new message based on the template and fill the four named bookmarks with the four values indicated.

In practice you would collect the values from a userform http://www.gmayor.com/Userform.htm or from some other location, but this post is just to demonstrate the basics.

Code:

Option Explicit

Sub CreateMessageWithBM()
Dim olItem As MailItem
Dim olEmail As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim vBM As Variant
Dim i As Long, j As Long
Dim strBMText As String
Const strBookmarks As String = "bmTest1|bmTest2|bmTest3|bmTest4"

    vBM = Split(strBookmarks, "|")
    Set olItem = CreateItemFromTemplate("D:\Word 2016 Templates\Bookmark test.oft")
    With olItem
        .BodyFormat = olFormatHTML
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        .Display
        For j = 0 To UBound(vBM)
            Select Case j
                Case Is = 0: strBMText = "This is the value for bookmark 1"
                Case Is = 1: strBMText = "This is the value for bookmark 2"
                Case Is = 2: strBMText = "This is the value for bookmark 3"
                Case Is = 3: strBMText = "This is the value for bookmark 4"
            End Select
            FillBM wdDoc, CStr(vBM(j)), strBMText
        Next j
    End With
lbl_Exit:
    Exit Sub
End Sub

Private Sub FillBM(odoc As Object, strbmName As String, strValue As String)
'Graham Mayor - http://www.gmayor.com
Dim oRng As Object
    With odoc
        On Error GoTo lbl_Exit
        Set oRng = .Bookmarks(strbmName).Range
        oRng.Text = strValue
        oRng.Bookmarks.Add strbmName
    End With
lbl_Exit:
    Set oRng = Nothing
    Exit Sub
End Sub