Combine Different Word files into one file and update Table of Content

tejaspareek · #1 11-02-2014, 10:43 PM

Hi,

I was working on a word file. In the file I need to combine multiple word files from a dynamic location (means the location can changed as per the requirement).
I got a static code, which is working. But i want to convert it to a dynamic code, where i can set the folder location using a folder picker.

Please help.

Static Code

Code:

Sub MergeDocs()
Dim rng As Range
Dim MainDoc As Document
Dim strFile As String
Set MainDoc = ActiveDocument
Const strFolder = "C:\Users\A020105\Desktop\Test\" 'change to suit
strFile = Dir$(strFolder & "*.docx") ' can change to .docx
Do Until strFile = ""
Set rng = MainDoc.Range
rng.Collapse wdCollapseEnd
rng.InsertBreak
rng.InsertFile strFolder & strFile
strFile = Dir$()
Loop
ActiveDocument.TablesOfContents(1).Update

End Sub

Dynamic Code

Code:

Private Sub Document_New()
'
'
Dim rng As Range
Dim MainDoc As Document
Dim strFile As Variant
Dim strFolder As FileDialog

Set MainDoc = ActiveDocument
Set strFolder = Application.FileDialog(msoFileDialogFolderPicker)
strFolder.AllowMultiSelect = True
strFolder.Show
strFile = Dir$(STFolder & "\" & "*.docx")
Do While strFile <> ""
Set rng = MainDoc.Range
rng.Collapse wdCollapseEnd
rng.InsertBreak
rng.InsertFile STFolder & strFile
strFile = Dir$()
Loop
ActiveDocument.TablesOfContents(1).Update
End Sub

gmaxey · #2 11-03-2014, 06:50 AM

You just need a function to define your static strFolder:

Code:

Sub TestMethods()
  MsgBox fcnFolderPicker_msoFileDialogMethod("Select folder")
  MsgBox fcnShellBrowseForFolder
End Sub
Function fcnFolderPicker_msoFileDialogMethod(strTitle As String, Optional strInitialPath As String = "C:\", Optional bAllowMulti As Boolean = False) As String
Dim strPath As String
Dim fDialog As FileDialog
  Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
  With fDialog 'Pick folder containing the files
    .Title = strTitle
    .AllowMultiSelect = bAllowMulti
    .InitialView = msoFileDialogViewList
    .InitialFileName = strInitialPath
    If .Show <> -1 Then
      fcnFolderPicker_msoFileDialogMethod = "Nothing selected, cancelled by user"
    Exit Function
    End If
    strPath = fDialog.SelectedItems.Item(1)
    fcnFolderPicker_msoFileDialogMethod = strPath
  End With
lbl_Exit:
  Exit Function
End Function

Function fcnShellBrowseForFolder(Optional strTitle As String, Optional strRootFolder As Variant) As String
  On Error Resume Next
  fcnShellBrowseForFolder = CreateObject("Shell.Application").BrowseForFolder(0, strTitle, 0, strRootFolder).Items.Item.Path
  On Error GoTo 0
lbl_Exit:
  Exit Function
End Function

tejaspareek · #3 11-04-2014, 03:32 AM

Thank you Greg for the reply,

However i am not able to link this function to my code. Can you please advise how to modify my codes provided above so that the function provided by you can be attached to it.

I am new with VBA and am not aware about the Functions.

gmaxey · #4 11-04-2014, 04:58 AM

Change your Const StrPath statement to a variable, add one of the functions to your code module and set your variable = to the function:

Code:

Private Sub NewCode()
Dim rng As Range
Dim MainDoc As Document
Dim strFile As Variant
Dim strFolder As String
strFolder = fcnShellBrowseForFolder
strFile = Dir$(strFolder & "\" & "*.docx")
Do While strFile <> ""
Set rng = MainDoc.Range
rng.Collapse wdCollapseEnd
rng.InsertBreak
rng.InsertFile strFolder & strFile
strFile = Dir$()
Loop
ActiveDocument.TablesOfContents(1).Update
End Sub
Function fcnShellBrowseForFolder(Optional strTitle As String, Optional strRootFolder As Variant) As String
  On Error Resume Next
  fcnShellBrowseForFolder = CreateObject("Shell.Application").BrowseForFolder(0, strTitle, 0, strRootFolder).Items.Item.Path
  On Error GoTo 0
lbl_Exit:
  Exit Function
End Function

tejaspareek · #5 11-04-2014, 05:50 AM

Thank you Greg,

The code works perfectly.

Code:

Private Sub Document_New()
Dim rng As Range
Dim MainDoc As Document
Dim strFile As Variant
Dim strFolder As String
Set MainDoc = ActiveDocument
strFolder = fcnShellBrowseForFolder
strFile = Dir$(strFolder & "\" & "*.docx")
Do While strFile <> ""
Set rng = MainDoc.Range
rng.Collapse wdCollapseEnd
rng.InsertBreak
rng.InsertFile strFolder & "\" & strFile
strFile = Dir$()
Loop
ActiveDocument.TablesOfContents(1).Update
End Sub
Function fcnShellBrowseForFolder(Optional strTitle As String, Optional strRootFolder As Variant) As String
  On Error Resume Next
  fcnShellBrowseForFolder = CreateObject("Shell.Application").BrowseForFolder(0, strTitle, 0, strRootFolder).Items.Item.Path
  On Error GoTo 0
lbl_Exit:
  Exit Function
End Function

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Referencing + Automatic update of Shared Content in MS Word.	mitucool	Word	14	10-09-2013 02:08 AM
How to combine many word files in one file but to have correct pages numbers and tabl	Jamal NUMAN	Word	6	04-20-2011 02:32 PM
SOS - cannot update table of content properly	Lee	Word	5	02-04-2011 12:59 PM
A Table of Contents that Will Dictate the Content of the File	ddhardy	Word	0	06-23-2010 06:01 AM
Combine pst files?	markg2	Outlook	2	04-26-2010 03:09 PM