locked
Merging text files along with their filename RRS feed

  • 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?
    Tuesday, March 25, 2014 5:56 PM

Answers

  • 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]


    • Edited by macropodMVP Tuesday, March 25, 2014 10:03 PM Changed code to output filename in first section footer instead of last section footer
    • Marked as answer by garveyk659 Thursday, March 27, 2014 1:08 PM
    Tuesday, March 25, 2014 9:22 PM

All replies

  • 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]


    • Edited by macropodMVP Tuesday, March 25, 2014 10:03 PM Changed code to output filename in first section footer instead of last section footer
    • Marked as answer by garveyk659 Thursday, March 27, 2014 1:08 PM
    Tuesday, March 25, 2014 9:22 PM
  • This is awesome. Thanks for the work on this and it is exactly what I wanted.
    Thursday, March 27, 2014 1:08 PM