Sub TestExport()
  Dim sName As String, sPath As String, aRng As TextRange
  Set aRng = Selection.ShapeRange(1).TextFrame.TextRange
  With ActiveDocument.MailMerge.DataSource
    .ActiveRecord = 1
    Do
      sName = .DataFields.Item("Name").Value
      aRng.Text = sName
      'sPath = ActiveDocument.Path & "\" & .DataFields.Item("JpgFileName").Value
      sPath = .DataFields.Item("JpgFolderPath").Value & "\" & .DataFields.Item("JpgFileName").Value
      ActiveDocument.Pages(1).SaveAsPicture Filename:=sPath, pbResolution:=pbPictureResolutionWeb_96dpi
      If .ActiveRecord = .RecordCount Then Exit Do
      .ActiveRecord = .ActiveRecord + 1
    Loop
  End With
End Sub