Merging text files along with their filename

Question

I am looking to merge a whole bunch of text files into one document. I am going to the Insert tab and selecting the drop down menu in Object to select text from file.  All of the text is merging in the one document correctly, but I am not
getting the title/file name of the document inserted in the document and I would like that to be in there. Is there a way of doing this?

Answer 1

Try the following macro. It assumes you're working with doc, docx & docm files. If not, change the 'doc' in the '*.doc' reference to whatever file type you're working with.
Option Explicit
Public oFolder As Object 'the folder object
Public i As Long, j As Long
Public DocTgt As Document
Sub Main()
' Minimise screen flickering
Application.ScreenUpdating = False
Dim StrFolder As String
' Browse for the starting folder
StrFolder = GetTopFolder
If StrFolder = "" Then Exit Sub
' Initialize the counters
i = 0: j = 0
Set DocTgt = ActiveDocument
' Search the top-level folder
Call GetFolder(StrFolder & "\")
' Return control of status bar to Word
Application.StatusBar = ""
' Restore screen updating
Application.ScreenUpdating = True
MsgBox i & " of " & j & " files processed.", vbOKOnly
End Sub
Function GetTopFolder() As String
GetTopFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetTopFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
Sub GetFolder(StrFolder As String)
Dim strFile As String
strFile = Dir(StrFolder & "*.doc")
' Process the files in the folder
While strFile <> ""
  ' Update the status bar is just to let us know where we are
  Application.StatusBar = StrFolder & strFile
  Call UpdateFile(StrFolder & strFile)
  strFile = Dir()
Wend
End Sub
Sub UpdateFile(strDoc As String)
Dim Doc As Document
' Open the document
Set Doc = Documents.Open(strDoc, AddToRecentFiles:=False, ReadOnly:=False, Format:=wdOpenFormatAuto, Visible:=False)
With Doc
  If .ProtectionType = wdNoProtection Then
  With .Range.Sections
    With .First.Footers(wdHeaderFooterPrimary).Range
      .InsertBefore Doc.Name & vbCr
      While .Characters.Last.Previous = vbCr
        .Characters.Last.Previous = vbNullString
      Wend
    End With
    .Add Start:=wdSectionBreakNextPage
  End With
  DocTgt.Characters.Last.FormattedText = .Range.FormattedText
    ' Update the file counter for processed files
    i = i + 1
  End If
  ' Update the main file counter
  j = j + 1
  .Close SaveChanges:=False
End With
' Let Word do its housekeeping
DoEvents
Set Doc = Nothing
End Sub
With this code, each merged file's name will be added to its footer.
Cheers
Paul Edstein
[MS MVP - Word]