none
Merge Multiple Word Files with File Names by VBA RRS feed

  • Question

  • Hello :

    I want macro would let me choose a folder to select.

    All files in the folder will be selected and merged into one Doc file, in the active doc.

    I also want, the FILE NAME to be on the contents of that specific file, so that, I can later trace back, which content refers to which original file.

    Any Help?

    In the net I have got a macro for getting file names (all files). 

    Like This:

    Sub GatherFileNames()
    '
    ' GatherFileNames Macro
    '
    '
    'Sub InsertNamesOfFilesInAFolder()
    
    Dim MyPath As String
    Dim MyName As String
    
    'let user select a path
    With Dialogs(wdDialogCopyFile)
        If .Display() <> -1 Then Exit Sub
        MyPath = .Directory
    End With
    
    'strip quotation marks from path
    
    If Len(MyPath) = 0 Then Exit Sub
    
    If Asc(MyPath) = 34 Then
        MyPath = Mid$(MyPath, 2, Len(MyPath) - 2)
    End If
    
    'get files from the selected path
    'and insert them into the doc
    MyName = Dir$(MyPath & "*.*")
    Do While MyName <> ""
        Selection.InsertAfter MyName & vbCr
        'Call ExtractText
        MyName = Dir
    Loop
    
    'collapse the selection
    Selection.Collapse wdCollapseEnd
    
    End Sub


    I have tried to CALL another macro (below) ExtractText inside the Do-Loop. As shown above.

    It does not provide the name and the loop creates a mess!

    Sub ExtractText()
    '
    ' ExtractText Macro
    '
    '
        ChangeFileOpenDirectory _
            "E:\D Drive Backup\Birganj Online Backup\Final 2\00 News24\00 News24\News Now\Contents\Feb\"
        Selection.InsertFile FileName:="19-03-14-Milon.doc", Range:="", _
            ConfirmConversions:=False, Link:=False, Attachment:=False
    End Sub

    I need a macro by removing the errors in a way that:

    1. I can select the folder at the beginning.

    2. It will only select the Doc & Docx Files.

    3. Any open doc file can merge all doc and docx files into it, with respective files names before the contents are appended.

    4. All appends be in asending Order by File Name (names of the files to be merged).

    Any help?


    • Edited by ANM Farukh Tuesday, March 25, 2014 8:19 PM
    Tuesday, March 25, 2014 8:12 PM

Answers

  • Since the code insert a 'Next Page' Section break between documents, I don't know how you can be getting more than one document on a page - unless you've changed the code. Still, if that's what you want, change:
       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

    to:
       DocTgt.Characters.Last.InsertBefore Doc.Name & vbCr
       DocTgt.Characters.Last.FormattedText = .Range.FormattedText


    Cheers
    Paul Edstein
    [MS MVP - Word]

    • Marked as answer by ANM Farukh Wednesday, March 26, 2014 7:39 AM
    Wednesday, March 26, 2014 6:40 AM

All replies

  • Try:

    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 <> ""
      If Right(strFile, 1) <> "m" Then
        ' Update the status bar is just to let us know where we are
        Application.StatusBar = StrFolder & strFile
        Call UpdateFile(StrFolder & strFile)
      End If
      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, the filenames will be inserted into the footer for each added file.


    Cheers
    Paul Edstein
    [MS MVP - Word]


    • Edited by macropodMVP Tuesday, March 25, 2014 10:02 PM Changed code to output filename in first section footer instead of last section footer
    Tuesday, March 25, 2014 9:18 PM
  • Dear macropod:

    Thank you. It's working quite well.

    May I ask for a little modification?

    Word files that we are merging here, do not always have contents enough to be as long as 01 full page. Thus, contents from 02 different files being placed in same page, may show same footer (i.e. file name here), is it happening here?

    I am interested to see the contents from other files, to be preceded by it's own file name, instead of putting the file name in the footer area. Help pls.

    Thanks,

    Wednesday, March 26, 2014 6:31 AM
  • Since the code insert a 'Next Page' Section break between documents, I don't know how you can be getting more than one document on a page - unless you've changed the code. Still, if that's what you want, change:
       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

    to:
       DocTgt.Characters.Last.InsertBefore Doc.Name & vbCr
       DocTgt.Characters.Last.FormattedText = .Range.FormattedText


    Cheers
    Paul Edstein
    [MS MVP - Word]

    • Marked as answer by ANM Farukh Wednesday, March 26, 2014 7:39 AM
    Wednesday, March 26, 2014 6:40 AM
  • Very usefull one thanks 
    Tuesday, December 23, 2014 6:31 PM
  • Hi Paul,

    Hope u r doing well,

    this code is giving a "Compile error: User-defiled type not defined"

    (Public DocTgt As Document)

    can you please help me with this?

    Tuesday, November 6, 2018 12:28 PM
  • Are you running the code from Word?

    Cheers
    Paul Edstein
    [MS MVP - Word]

    Tuesday, November 6, 2018 9:17 PM