Option Explicit
Sub AddPicsWithGPSCoordinates()
Dim oStyle As Style, lngIndex As Long, oShp As InlineShape
Dim oTbl As Table, sngTblWidth As Single, strGPS As String, sngRowHght As Single, sngColWdth As Single
  Application.ScreenUpdating = False
  With ActiveDocument.PageSetup
    sngTblWidth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
  End With
  sngColWdth = 340
  sngRowHght = 140
  With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Select image files and click OK"
    .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
    .FilterIndex = 2
    If .Show = -1 Then
      With ActiveDocument
        On Error Resume Next
        Set oStyle = .Styles("TblPic")
        If oStyle Is Nothing Then Set oStyle = .Styles.Add(Name:="TblPic", Type:=wdStyleTypeParagraph)
        On Error GoTo 0
        With oStyle.ParagraphFormat
          .Alignment = wdAlignParagraphCenter
          .KeepWithNext = True
          .SpaceAfter = 0
          .SpaceBefore = 0
        End With
      End With
      Set oTbl = Selection.Tables.Add(Range:=Selection.Range, NumRows:=1, NumColumns:=2)
      With oTbl
        .AutoFitBehavior (wdAutoFitFixed)
        .TopPadding = 0
        .BottomPadding = 0
        .LeftPadding = 0
        .RightPadding = 0
        .Spacing = 0
        .Columns(1).Width = sngColWdth
        .Columns(2).Width = sngTblWidth - sngColWdth
        .Borders.Enable = True
        With .Rows(1)
         .Height = sngRowHght
         .HeightRule = wdRowHeightExactly
         .Range.Style = "TblPic"
         .Cells.VerticalAlignment = wdCellAlignVerticalCenter
        End With
      End With
      For lngIndex = 1 To .SelectedItems.Count
        'Insert the Picture
        Set oShp = ActiveDocument.InlineShapes.AddPicture( _
          FileName:=.SelectedItems(lngIndex), LinkToFile:=False, _
           SaveWithDocument:=True, Range:=oTbl.Cell(lngIndex, 1).Range)
        With oShp
          .LockAspectRatio = True
          If (.Width < sngColWdth) And (.Height < sngRowHght) Then
            .Width = sngColWdth
            If .Height > sngRowHght Then .Height = sngRowHght
          End If
        End With
        'Get the Image name for the Caption
        strGPS = fcnGetGPSInfo(.SelectedItems(lngIndex))
        oTbl.Cell(lngIndex, 2).Range.Text = "Location" & vbCr & strGPS
        oTbl.Rows.Add
      Next lngIndex
      oTbl.Rows.Last.Delete
    End If
  End With
ErrExit:
  Application.ScreenUpdating = True
End Sub

Function fcnGetGPSInfo(strPath) As String
'You will need to stet a reeference to Microsoft Shell Controls and Automation
Dim objShell As New Shell
Dim oFSO As Object, oFile As Object, oFolder As Object
Dim varLat, varLng, strLat, strLong
Dim strFolder As String, strFile As String
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Set oFile = oFSO.GetFile(strPath)
  strFile = oFile.Name
  strFolder = oFile.ParentFolder.Path
  Select Case oFile.Type
    Case "JPEG File", "PNG File", "GIF File", "JPG File", "BMP File"
      Set oFolder = objShell.Namespace(strFolder)
      Set oFile = oFolder.ParseName(strFile)
      varLat = oFile.ExtendedProperty("{8727CFFF-4868-4EC6-AD5B-81B98521D1AB}100")
      varLng = oFile.ExtendedProperty("{C4C4DBB2-B593-466B-BBDA-D03D27D5E43A}100")
      If Not IsEmpty(varLat) Then
        strLat = varLat(0) & Chr(176) & varLat(1) & "'" & Format(varLat(2), "0.00") & """"
      Else
        strLat = 0
      End If
      If Not IsEmpty(varLng) Then
        strLong = varLng(0) & Chr(176) & varLng(1) & "'" & Format(varLng(2), "0.00") & """"
      Else
        strLong = 0
      End If
      fcnGetGPSInfo = "Lat: " & strLat & vbCr & "Long: " & strLong
      Set oFile = Nothing
      Set oFolder = Nothing
  End Select
lbl_Exit:
  Exit Function
End Function