Extract the values in a drop-down field

Question

I would like to extract the values in a drop-down field with the title "email address".

I would like the name selected to appear in the email "To" line. I'm adding the ActiveDocument details to the subject line but would like to remove the .docx portion of the subject line.

Do I need separate Outlook code?

Sub RunAll() 
    Call Save 
    Call sendeMail 
End Sub 
         
         
Sub Save()               
    Dim strPath As String 
    Dim strPlate As String 
    Dim strName As String 
    Dim strFilename As String 
    Dim oCC As ContentControl 
             
    strPath = "C:\Users\******x\Desktop\Test 4" 
    CreateFolders strPath 
             
    On Error GoTo err_Handler 
    Set oCC = ActiveDocument.SelectContentControlsByTitle("License Plate Number").Item(1) 
    If oCC.ShowingPlaceholderText Then 
        MsgBox "Complete the License plate number!" 
        oCC.Range.Select 
        GoTo lbl_Exit 
    Else 
        strPlate = oCC.Range.Text 
    End If 
             
    Set oCC = ActiveDocument.SelectContentControlsByTitle("Customer Name").Item(1) 
    If oCC.ShowingPlaceholderText Then 
        MsgBox "Complete the Customer Name!" 
        oCC.Range.Select 
        GoTo lbl_Exit 
    Else 
        strName = oCC.Range.Text 
    End If 
             
    strFilename = strPlate & "__" & strName & ".docx" 
    ActiveDocument.SaveAs2 FileName:=strPath & strFilename, FileFormat:=12

lbl_Exit: 
    Set oCC = Nothing 
    Exit Sub

err_Handler: 
    MsgBox Err.Number & vbCr & Err.Description 
    Err.Clear 
    GoTo lbl_Exit 
End Sub      

     
Private Sub CreateFolders(strPath As String)
    Dim oFSO As Object 
    Dim lngPathSep As Long 
    Dim lngPS As Long 
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\" 
    lngPathSep = InStr(3, strPath, "\") 
    If lngPathSep = 0 Then GoTo lbl_Exit 
    Set oFSO = CreateObject("Scripting.FileSystemObject") 
    Do 
        lngPS = lngPathSep 
        lngPathSep = InStr(lngPS + 1, strPath, "\") 
        If lngPathSep = 0 Then Exit Do 
        If Len(Dir(Left(strPath, lngPathSep), vbDirectory)) = 0 Then Exit Do 
    Loop 
    Do Until lngPathSep = 0 
        If Not oFSO.FolderExists(Left(strPath, lngPathSep)) Then 
            oFSO.CreateFolder Left(strPath, lngPathSep) 
        End If 
        lngPS = lngPathSep 
        lngPathSep = InStr(lngPS + 1, strPath, "\") 
    Loop

lbl_Exit: 
    Set oFSO = Nothing 
    Exit Sub 
End Sub 

     
Private Sub sendeMail() 
    Dim olkApp As Object 
    Dim strSubject As String 
    Dim strTo As String 
    Dim strBody As String 
    Dim strAtt As String 
         
    strSubject = "VR*** Request:   " + ActiveDocument + "    CUSTOMER IS xx xx xx" 
    strBody = "" 
    strTo = "" 
    If ActiveDocument.FullName = "" Then 
        MsgBox "activedocument not saved, exiting" 
        Exit Sub 
    Else 
        If ActiveDocument.Saved = False Then 
            If MsgBox("Activedocument NOT saved, Proceed?", vbYesNo, "Error") <> vbYes Then Exit Sub 
        End If 
    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

Answer 1

To get the doc's name without the extension, you can use this:

Left(ActiveDocument.Name, InStrRev(ActiveDocument.Name, ".") - 1)

• InStrRev finds the last "dot" .
• Left truncates the name until that position
• -1 applied to the found position is to also remove the . itself

For example,

strSubject = "VR*** Request:   " & Left(ActiveDocument.Name, InStrRev(ActiveDocument.Name, ".") - 1) & "    CUSTOMER IS xx xx xx"

---

Addendum

To get the email address from a content-control titled "email address", you can use this function:

Function getEmailAddress()
    Dim sh As ContentControl
    For Each sh In ThisDocument.Range.ContentControls
        If sh.Title = "email address" Then
            getEmailAddress = sh.Range.Text
            Exit Function
        End If
    Next
End Function

i.e.

With olkApp.createitem(0) 
    .To = getEmailAddress
    ' etc...