Extract the values in a drop-down field - vba

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...