MS Word Photo Caption Macro - vba

Question

The purpose of this code is to allow the end-use to put two pictures per page. It also has the purpose of putting the last 4 numbers of the photo as the caption minus the ".extension" (ie. .jpg). How do I remove the auto-numbering of the photos and remove the ".jpg" (extension) from the code below? I figured out how to turn off the Picture label.
Sub AddPic()
Dim fd As FileDialog
Dim oTbl As Table
Dim oILS As InlineShape
Dim vrtSelectedItem As Variant
Dim dotPos As Long
Dim lenName As Long
Dim capt As String
'''''''''''''''
'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:=" "
For Each vrtSelectedItem In .SelectedItems
dotPos = InStr(vrtSelectedItem, ".")
lenName = Len(vrtSelectedItem)
capt = Mid(vrtSelectedItem, lenName + (dotPos - 4 - lenName))
With Selection
Set oILS = .InlineShapes.AddPicture(FileName:= _
vrtSelectedItem, LinkToFile:=False, SaveWithDocument:=True, _
Range:=Selection.Range)
oILS.Range.InsertCaption Label:=" ", Title:=capt, _
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

The more elegant way is to work with Range objects, such as used in the Answer to your other question. But since you appear to be more comfortable with Selection, I've used that in the code snippet below.
If neither numbering nor a caption label is wanted, it makes no sense to use the InsertCaption functionality, which specifically does those things. Instead, simply insert the text at the desired position (below the picture).
The code does this by selecting the picture, moving one character to the right (pressing the right-arrow key) then inserting the text. Note that the first character is a paragraph mark (pressing Enter), then the caption.
The "last 4 numbers of the photo" - I assume "file name" is meant - can be done by limiting the string Mid returns to four characters. (See the , 4 added to it.)
For Each vrtSelectedItem In .SelectedItems
dotPos = InStr(vrtSelectedItem, ".")
lenName = Len(vrtSelectedItem)
capt = Mid(vrtSelectedItem, lenName + (dotPos - 4 - lenName), 4)
With Selection
Set pic = .InlineShapes.AddPicture(fileName:= _
vrtSelectedItem, LinkToFile:=False, SaveWithDocument:=True, _
Range:=Selection.Range)
pic.Range.Select
.MoveRight wdCharacter
Selection.Text = vbCr & capt
.MoveRight wdCell, 1
End With
Next vrtSelectedItem