Microsoft Office Forums - View Single Post - Create bookmark and use it in macrobutton

gmayor · 05-28-2015, 01:13 AM

Your message says 'field'! What kind of field?

In practice you can read the cell content directly without using a bookmark e.g. the following will read cell Row 1, Column 1 of Table 1 and use that as the message recipient. The code also assumes Outlook is available.

The code goes in an ordinary module in the document itself which should be saved as macro enabled. - http://www.gmayor.com/installing_macro.htm

Code:

Option Explicit

Sub SendMessage()
Dim olApp As Object
Dim olEmail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Range

    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo err_Handler
    Set olEmail = olApp.CreateItem(0)
    With olEmail
        .BodyFormat = 2
        .to = GetCell(ActiveDocument.Tables(1), 1, 1)        'Last two digits are row and column
        .Subject = "This is the message subject"
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range(0, 0)
        oRng.Text = "This is the message body text" & vbCr & _
                    "This is another line of message body."
        .Display
        '.Send 'remove apostrophe from the start of the line after testing
    End With
lbl_Exit:
    Set olApp = Nothing
    Set olEmail = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Exit Sub
err_Handler:
    MsgBox "There has been an uncorrected error -" & vbCr & vbCr & "Number: " & _
           Err.Number & vbCr & "Description: " & Err.Description
    GoTo lbl_Exit
End Sub

Public Function GetCell(oTable As Table, _
                        iRow As Long, _
                        iCol As Long) As String
Dim oCell As Range
Dim strText As String
    Set oCell = oTable.Cell(iRow, iCol).Range
    oCell.End = oCell.End - 1
    GetCell = oCell.Text
    MsgBox GetCell
lbl_Exit:
    Exit Function
End Function