Sub ExportDocs()
Application.ScreenUpdating = False
Dim strFolder As String, wdDoc As Document, i As Long
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
  .Title = "Select the source document containing the Find/Replace Table"
  .AllowMultiSelect = True
  If .Show = -1 Then
    strFolder = GetFolder
    If strFolder = "" Then
      MsgBox "No output folder selected. Exiting", vbCritical
      Exit Sub
    End If
    For i = 1 To .SelectedItems.Count
      Set wdDoc = Documents.Add(.SelectedItems(i))
      With wdDoc
        .SaveAs2 FileName:=strFolder & "\" & Split(.AttachedTemplate.Name, ".dot")(0) & ".docx", _
          Fileformat:=wdFormatXMLDocument, AddToRecentFiles:=False
        .Close False
      End With
    Next
  Else
    MsgBox "No source file selected. Exiting", vbExclamation
    Exit Sub
  End If
End With
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose an output folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function