MS Word Caption with the Image Name - vba

Question

The code below works like a charm. It allows the user to pick a folder with .jpgs and other image types into a 2 image per page. The Current code just captions the image as "Picture". What I am needing assistance with is getting the image name as caption minus the .jpg. Any direction would be great:
Sub AddPic()
Dim fd As FileDialog
Dim oTbl As Table
Dim oILS As InlineShape
Dim vrtSelectedItem As Variant
'''''''''''''''
'Add a 1 row 2 column table to take the images
'''''''''''''''
Set oTbl = Selection.Tables.Add(Selection.Range, 4, 1)
With oTbl
.AutoFitBehavior (wdAutoFitWindow)
End With
'''''''''''''''
Set fda = Application.FileDialog(msoFileDialogFilePicker)
With fda
.Title = "Select image files and click OK"
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
.FilterIndex = 2
If .Show = -1 Then
CaptionLabels.Add Name:="Picture"
For Each vrtSelectedItem In .SelectedItems
With Selection
Set oILS = .InlineShapes.AddPicture(FileName:= _
vrtSelectedItem, LinkToFile:=False, SaveWithDocument:=True, _
Range:=Selection.Range)
oILS.Range.InsertCaption Label:="Picture", TitleAutoText:="", Title:="", _
Position:=wdCaptionPositionBelow, ExcludeLabel:=0
.MoveRight wdCell, 1
End With
Next vrtSelectedItem
If Len(oTbl.Rows.Last.Cells(1).Range) = 2 Then oTbl.Rows.Last.Delete
Set fd = Nothing
End If
End With
'''''''''''''''
For Each pic In ActiveDocument.InlineShapes
With pic
.LockAspectRatio = msoFalse
If .Width > .Height Then ' horizontal
.Width = InchesToPoints(5.5)
.Height = InchesToPoints(3.66)
Else ' vertical
.Width = InchesToPoints(5.5)
End If
End With
Next
'''''''''''''''
Selection.WholeStory
Selection.Font.Bold = wdToggle
Selection.Font.Bold = wdToggle
Selection.Font.Color = wdColorBlack
'''''''''''''''
End Sub

Answer 1

It appears vrtSelectedItem provides the information that's required, so the only problem is cutting off the file extension.
This can be done by string manipulation. In the code snippet below, taken from the question, the location of the . in the file name is ascertained, as well as the length of the file name. The Mid function is then used to extract the text to the left of that point.
Dim dotPos as long, lenName as Long
Dim capt as String
For Each vrtSelectedItem In .SelectedItems
dotPos = Instr(vrtSelectedItem, ".")
lenName = Len(vrtSelectedItem)
capt = Mid(vrtSelectedItem, lenName + (dotPos - 1 - lenName ))
With Selection
Set oILS = .InlineShapes.AddPicture(FileName:= _
vrtSelectedItem, LinkToFile:=False, SaveWithDocument:=True, _
Range:=Selection.Range)
oILS.Range.InsertCaption Label:="Picture", TitleAutoText:="", Title:=capt, _
Position:=wdCaptionPositionBelow, ExcludeLabel:=0
.MoveRight wdCell, 1
End With
Next vrtSelectedItem