View Single Post
 
Old 09-25-2014, 05:17 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,375
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote