Try the following macro. It allows the user to select a single new form to use as a template for the output files, then an output folder, then all the source files from which the data are to be transferred. A new output document is created in the output folder with the same name as each of the source files. Output files are saved in the .docx format.
Code:
Sub DataReplication()
Dim NewFile As Variant, OldFile As Variant, StrFoldr As String
Dim DocSrc As Document, DocTgt As Document, FmFld As FormField
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Please select the new form"
.AllowMultiSelect = False
.Filters.Add "Documents & Templates", "*.doc*; *.docx; *.dot*", 1
'use Show method to display File Picker dialog box and return user's action
If .Show = -1 Then
NewFile = .SelectedItems(1)
Else
Exit Sub
End If
End With
StrFoldr = GetFolder(Title:="Select the Destination Folder", RootFolder:="C:\Users\" & Environ("UserName"))
If StrFoldr = "" Then Exit Sub
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Please select the old documents"
.AllowMultiSelect = True
.Filters.Add "Documents", "*.doc; *.docx", 1
'use Show method to display File Picker dialog box and return user's action
If .Show = -1 Then
'step through each item in the collection
For Each OldFile In .SelectedItems
Set DocTgt = Documents.Add(NewFile, Visible:=False)
Set DocSrc = Documents.Open(OldFile, AddToRecentFiles:=False, Visible:=False)
With DocTgt
For Each FmFld In .FormFields
FmFld.Result = DocSrc.FormFields(FmFld.Name).Result
Next
.SaveAs StrFoldr & "\" & Split(DocSrc.Name, ".")(0) & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
.Close False
End With
DocSrc.Close False
Next
Else
Exit Sub
End If
End With
End Sub