Import picture file name along with photo into cell

Hello. Thanks in advance for your time.

I use the below macro to import pictures into cells and resize the photo. It works great. However I would also like to import the text from the file name (minus the file extension) and past that into an adjacent cell (15 cells below the active cell). Is this possible? Thanks!

Here is what I have so far, but it imports the whole photo location string along with the name. I'm just looking for the imported picture name. Any suggestions?

Sub InsertPic()
Dim PicLocation As Variant

PicLocation = Application.GetOpenFilename()
If PicLocation = False Then
Range("B32") = ""
Else
ActiveSheet.Shapes.AddPicture(PicLocation, False, True, ActiveCell.Left, ActiveCell.Top, 246, 176).Select
With Selection
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Rotation = 0#
Selection.ShapeRange.IncrementTop 2
Selection.ShapeRange.IncrementLeft 2
GetPName = PicLocation
ActiveCell.Offset(15, 0).Select
ActiveCell = GetPName

End With
End If
End Sub

Use InStrRev to get the last backwards slash and parse the string from there. Use it again on the result to find the last period and parse the file name from the extension.