Sub Send_PDF_As_Attachment()
Dim oOutlookApp As Object
Dim oItem As Object
Dim olInsp As Object
Dim strFname As String
Dim wdDoc As Document
Dim oRng As Range

    With ActiveDocument
        strFname = .SaveAs2(Filename:="C:\Users\" & Environ("Username") & "\Documents\" & _
         .SelectContentControlsByTitle("MyControl")(1).Range.Text & ".PDF", _
         FileFormat:=wdFormatPDF)
    End With

    On Error Resume Next
    'Get Outlook if it's running
    Set oOutlookApp = GetObject(, "Outlook.Application")

    'Outlook wasn't running, start it from code
    If Err <> 0 Then
        Set oOutlookApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    'Create a new mailitem
    Set oItem = oOutlookApp.CreateItem(0)

    With oItem
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        oRng.Collapse 1
        oRng.Text = "This is the message body"
        .to = "someone@somewhere.com"
        .Subject = "This is the subject"
        .BodyFormat = 2
        .Attachments.Add strFname
        .Display
    End With

    'Clean up
    Set oItem = Nothing
    Set oOutlookApp = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
lbl_Exit:
    Exit Sub
End Sub