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