Sending Document by Text Form Field

[Loss1003]

I have word 2010 document that includes form fields. I’d like to send the document into outlook and have the subject line name pulled from one of the text form fields (bookmark as Aname & PolNum). The following code works except the subject includes the wording (FORMTEXT) before the aname and PolNum. I've tried protecting and unprotecting the document to see if that helped. Thanks for your help.

Sub sendeMail()
Dim olkApp As Object
Dim strSubject As String
Dim strTo As String
Dim strBody As String
Dim strAtt As String
  
 '  Dim Temp As String
  ' Temp = ActiveDocument.FormFields("Text1").Result
  ' ActiveDocument.FormFields("Text2").Result = Temp
 
 
  '  strSubject = "Whatever!"
  strSubject = "Quality Questionnaire" & " - " & ActiveDocument.Bookmarks("Aname").Range.Text & " - " & ActiveDocument.Bookmarks("PolNum").Range.Text
    strBody = "In striving to provide the best information possible to our associates, we ask you to please take five minutes to fill out this questionnaire and Email the completed form to:  MKLLosscontrolQQ@markelcorp.com"
    strTo = ""
    If ActiveDocument.Fullname = "" Then
        MsgBox "activedocument not saved, exiting"
        Exit Sub
    Else
        If MsgBox("Activedocument NOT saved, Proceed?", vbYesNo, "Error") <> vbYes Then Exit Sub
    End If
    strAtt = ActiveDocument.Fullname
   
    Set olkApp = CreateObject("outlook.application")
    With olkApp.createitem(0)
        .to = strTo
        .Subject = strSubject
        .body = strBody
        .attachments.Add strAtt
        '.send
        .Display
    End With
    Set olkApp = Nothing
End Sub

[Loss1003]

Please close I figured this out by using

Dim Temp As String
Temp = ActiveDocument.FormFields("Aname").Result

etc.

[gmayor]

You need to introduce some error checking and you presumably want to hyperlink the e-mail address?

Option Explicit

Sub sendeMail()
Dim olApp As Object
Dim olInsp As Object
Dim olItem As Object
Dim wdDoc As Document
Dim oRng As Range
Dim strTo As String
Dim strSubject As String
Dim strName As String
Dim strPolNum As String
Dim strBody As String
Dim strAtt As String
Dim oFld As FormField
Dim bFld As Boolean
Dim bStarted As Boolean
Dim oLink As Hyperlink
Const strLink = "mailto:MKLLosscontrolQQ@markelcorp.com?subject=Subject%20Questionnaire"        ' the link address
Const strLinkText = "MKLLosscontrolQQ@markelcorp.com"        ' the link display text
    If Documents.Count = 0 Then
        MsgBox "No document open!"
        GoTo lbl_Exit
    End If
    If ActiveDocument.FormFields.Count = 0 Then
        MsgBox "There are no form fields in the active document!"
        GoTo lbl_Exit
    End If
    For Each oFld In ActiveDocument.FormFields
        If oFld.Name = "Text1" Then
            strTo = oFld.Result
            bFld = True
            Exit For
        End If
    Next oFld
    If bFld = False Then
        MsgBox "The field 'Text1' is not present in the document."
        GoTo lbl_Exit
    End If
    If strTo = "" Then
        MsgBox "Enter a value in the field 'Text1' and run the macro again."
        GoTo lbl_Exit
    End If

    For Each oFld In ActiveDocument.FormFields
        If oFld.Name = "Aname" Then
            strName = oFld.Result
            bFld = True
            Exit For
        End If
    Next oFld
    If bFld = False Then
        MsgBox "The field 'Aname' is not present in the document."
        GoTo lbl_Exit
    End If
    If strName = "" Then
        MsgBox "Enter a value in the field 'Aname' and run the macro again."
        GoTo lbl_Exit
    End If

    For Each oFld In ActiveDocument.FormFields
        If oFld.Name = "PolNum" Then
            strPolNum = oFld.Result
            bFld = True
            Exit For
        End If
    Next oFld
    If bFld = False Then
        MsgBox "The field 'PolNum' is not present in the document."
        GoTo lbl_Exit
    End If
    If strPolNum = "" Then
        MsgBox "Enter a value in the field 'PolNum' and run the macro again."
        GoTo lbl_Exit
    End If

    If ActiveDocument.Path = "" Then
        MsgBox "Activedocument not saved, exiting"
        Exit Sub
    Else
        ActiveDocument.Save
    End If
    strAtt = ActiveDocument.FullName
    strSubject = "Quality Questionnaire" & " - " & strName & " - " & strPolNum
    strBody = "In striving to provide the best information possible to our associates, we ask you to please take five minutes to fill out this questionnaire and Email the completed form to:  "
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        Set olApp = CreateObject("Outlook.Application")
        bStarted = True
    End If
    On Error GoTo err_Handler
    Set olItem = olApp.createitem(0)
    With olItem
        .to = strTo
        .Subject = strSubject
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range(0, 0)
        Set oLink = wdDoc.Hyperlinks.Add(Anchor:=oRng, _
                                         Address:=strLink, _
                                         SubAddress:="", _
                                         ScreenTip:="", _
                                         TextToDisplay:=strLinkText)
        oRng.Collapse 1
        oRng.Text = strBody
        .attachments.Add strAtt
        .Display        'This line is required
        '.send    'Restore after testing
    End With
lbl_Exit:
    Set olApp = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oLink = Nothing
    Set oRng = Nothing
    Exit Sub
err_Handler:
    MsgBox Err.Number & vbCr & Err.Description
    Err.Clear
    GoTo lbl_Exit
End Sub