Necesito una macro que me seleccione fotos especificas de una carpeta

Buenas, tengo una macro que me abre una ventana para escoger fotos de la carpeta que yo quiera, el problema, es que no me deja seleccionar las fotos que yo quiera, me incrusta todas las fotos que tengo en la carpeta, y el otro problema, es intentar incluir en la macro la compresión de las fotos. A ver si se puede solucionar, y gracias por adelantado.

Sub StarredPhotosHub()
Dim myPicture As String
myPicture = Application.GetOpenFilename _
("Fotos (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", _
, "Selecciona carpeta para importar")
If myPicture = "False" Then Exit Sub
myPicture = Left(myPicture, InStrRev(myPicture, "\"))
InsertAllPixHub Range("A1"), _
myPicture, _
"*.jpg"
End Sub
Sub InsertAllPixHub(r As Range, ByVal sDir As String, sFilt As String)
Dim sPic As String
Dim iRow As Long
Dim iCol As Long
Application.ScreenUpdating = False
If Right(sDir, 1) <> "\" Then sDir = sDir & "\"
sPic = Dir(sDir & sFilt)
iRow = 45
iCol = 3
Do While (Len(sPic) / 3)
Do While (iCol < 16)
On Error Resume Next
With ActiveSheet.Pictures.Insert(sDir & sPic)
.ShapeRange.LockAspectRatio = msoFalse
.Height = 12 * r(iRow, iCol).Height
.Width = 4 * r(iRow, iCol).Width
.Top = r(iRow, iCol).Top
.Left = r(iRow, iCol).Left
.Placement = xlMoveAndSize
End With
iCol = iCol + 5
sPic = Dir
Loop
iCol = 3
iRow = iRow + 18
Loop
MsgBox "Ahora comprime las fotos pulsando la tecla Ctrl + [1], escoger comprimir y elegir todas las imagenes y en formato web", vbInformation, "Aviso Importante"
Range("C22").Select
End Sub