PDA

View Full Version : [SOLVED:] Merge multiple documents into one using UserForm



tomaszko
08-16-2017, 08:17 AM
Guys,
I have found a code that merges multiple word documents into one by using folder browser.


Option Explicit
Sub MergeDocs()
Dim rng As Range
Dim MainDoc As Document
Dim strFile As String, strFolder As String
Dim Count As Long
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Pick folder"
.AllowMultiSelect = False
If .Show Then
strFolder = .SelectedItems(1) & Application.PathSeparator
Else
Exit Sub
End If
End With
Count = 0
strFile = Dir$(strFolder & "*.doc") ' can change to .docx
Do Until strFile = ""
WordBasic.DisableAutoMacros 1
If Count = 0 Then
Set MainDoc = Documents.Add(Template:=strFolder & strFile)
Count = Count + 1
Else
Set rng = MainDoc.Range
With rng
.Collapse 0
If Count > 0 Then
.InsertBreak Type:=wdSectionBreakNextPage
.End = MainDoc.Range.End
.Collapse 0
End If
.InsertFile strFolder & strFile
End With
End If
strFile = Dir$()
WordBasic.DisableAutoMacros 0
Loop
MsgBox ("Files are merged")
lbl_Exit:
Exit Sub
End Sub

source: /showthread.php?51797-Macro-to-merge-mulitple-word-doc-into-one-word-doc&p=354802&viewfull=1#post354802



I'm trying to make a UserForm that will contain checkboxes that are "linked" to a specified file in the same location as source file.
Eg. If user marks checkbox A (which is linked to docuemnt A.docx), then marks checkbox B and so on. Then after all checkboxes are marked and "Finish" button is clicked the code above will merge choosed files (by marking checkboxes in UserForm).

I can manage to make UserForm with checkboxes and all but I don't know the way to "link" ckeckbox to a file and then modify code above to merge those files.

Can someone help me and modify code above to merge files that are only marked by checkboxes?

macropod
08-16-2017, 08:59 PM
For that your userform's Command Button would use code along the lines of:

Private Sub CommandButton1_Click()
Dim DocTgt As Document, DocSrc As Document
Set DocTgt = ActiveDocument
If Me.CheckBox1.Value = True Then
Set DocSrc = Documents.Open(FileName:="Path & FilenameA.docx", _
ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
DocTgt.Range.Characters.Last.FormattedText = DocSrc.Range.FormattedText
End If
If Me.CheckBox2.Value = True Then
Set DocSrc = Documents.Open(FileName:="Path & FilenameB.docx", _
ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
DocTgt.Range.Characters.Last.FormattedText = DocSrc.Range.FormattedText
End If
If Me.CheckBox3.Value = True Then
Set DocSrc = Documents.Open(FileName:="Path & FilenameC.docx", _
ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
DocTgt.Range.Characters.Last.FormattedText = DocSrc.Range.FormattedText
End If
If Me.CheckBox4.Value = True Then
Set DocSrc = Documents.Open(FileName:="Path & FilenameD.docx", _
ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
DocTgt.Range.Characters.Last.FormattedText = DocSrc.Range.FormattedText
End If
End Sub
The above code assumes your userform's:
• Command Button is named CommandButton1
• Checkboxes are named CheckBox1 - CheckBox4
You will, of course, need to supply the correct filepaths & filenames.

As coded, each inserted document is added to the end of the active document.

tomaszko
08-21-2017, 03:07 AM
Thanks macropod!
Works like a charm, but can you make few tweaks?

- Each file is added as a new section (Section Breaks -> Next Page)
- How I can make it use files from current directory and sub directories without giving it the full path to the file? It needs to be runned on few computers.


FileName:="\SubDirectory1\SubsubDirectory1\FilenameA.docx"
dont work

Thanks!

macropod
08-21-2017, 03:30 AM
For the Section breaks your could replace:
DocTgt.Range.Characters.Last.FormattedText = DocSrc.Range.FormattedText
with:

With DocTgt.Range.Characters
.Last.InsertAfter vbCr
.Last.InsertBreak wdSectionBreakNextPage
.Last.FormattedText = DocSrc.Range.FormattedText
End With
For the filename you might use:
FileName:=DocTgt.Path & "\FilenameA.docx"
or:
FileName:=DocTgt.Path & "\SubDirectory\FilenameA.docx"