Microsoft Office Forums - View Single Post - Transfer Outlook TextBox Text Into Email Body

gmayor · 05-25-2017, 12:23 AM

This is fairly straightforward using a pre-prepared template a simple userform and a macro to create the message. Here there are four fields, but you can have more or fewer as required and the labels simply reflect the content of the text fields.

The code for the form is:

Code:

Option Explicit

Private Sub CommandButton1_Click()
    Hide
    Tag = 1
End Sub

Private Sub CommandButton2_Click()
    Hide
    Tag = 2
End Sub

The code works in conjunction with an Outlook template here 'C:\Path\TemplateName.oft' which for the purpose of the exercise looks like

Note there are four texts bounded by ##. These are texts that the macro following will replace, and equate to the userform text fields.

The main code goes in a new module in the Outlook project. The line
Const sFindText As String = "#Name#|#Desc#|#Acres#|#Value#"
is a list of the fields/texts separated by the pipe character '|'. Obviously these have to match what you put in your template.

The macro opens the template and replaces the texts with the values entered in the userform then displays the message

Code:

Option Explicit

Sub ReplaceFromUserForm()
Dim olItem As MailItem
Dim olEmail As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim i As Long, j As Long
Const sFindText As String = "#Name#|#Desc#|#Acres#|#Value#"
Dim sReplaceText As String
Dim vFind As Variant
    With UserForm1
        .Caption = "Complete the fields"
        .CommandButton1.Caption = "Continue"
        .CommandButton2.Caption = "Cancel"
        .Show
        vFind = Split(sFindText, "|")
        Set olItem = CreateItemFromTemplate("C:\Path\TemplateName.oft")
        With olItem
            .BodyFormat = olFormatHTML
            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            .Display
            For j = 0 To UBound(vFind)
                Set oRng = wdDoc.Range
                Select Case j
                    Case 0
                        sReplaceText = UserForm1.TextBox1.Text
                    Case 1
                        sReplaceText = UserForm1.TextBox2.Text
                    Case 2
                        sReplaceText = UserForm1.TextBox3.Text
                    Case 3
                        sReplaceText = UserForm1.TextBox4.Text
                    Case Else
                End Select
                With oRng.Find
                    Do While .Execute(findText:=vFind(j))
                        oRng.Text = sReplaceText
                        oRng.collapse 0
                        DoEvents
                    Loop
                End With
            Next j
            .Display
        End With
    End With
    Unload UserForm1
lbl_Exit:
    Exit Sub
End Sub