Folks,

good day to all.

I am needing assistance on my task that has a loop in it and subfolders.

First my apologies - as I have messed the code up -trying to make it between word and excel.

I am trying to loop through subfolders and do a merge task on each folder.

There are many scripts for merging only one folder.

Now i have borrowed the ideas from here.

http://www.vbaexpress.com/forum/show...-it-from-excel

Sub MergeDocs() 
  
    Const wdCollapseEnd As Long = 0, wdPageBreak As Long = 7 
    Dim objWord As Object, strFile As String, strFile1 As String, strFolder As String 
     
     strFolder = "C:\Users\DJ\Desktop\Files"       ' This folder has all the subfolders
     
     ' Get/Create Word Application object
    On Error Resume Next 
    Set objWord = GetObject(, "Word.Application") 
    If Err <> 0 Then Set objWord = CreateObject("Word.Application") 
     
     ' Trap errors
    On Error GoTo exit_ 
     
   

    ' I am trying to save the Merged file name as  the folder name

    strFile = Dir$(strFolder & "*.doc*")                              
    strFile1 = strFile 
     
     ' Merge documents
    If Len(strFile) Then 
        With objWord.Documents.Open(strFolder & strFile, , True).Range 
            While Len(strFile) 
                If strFile <> strFile1 Then 
                    With .Characters.Last 
                        .Collapse wdCollapseEnd 
                        .InsertBreak wdPageBreak 
                        .InsertFile strFolder & strFile 
                    End With 
                End If 
                strFile = Dir$ 
            Wend 
        End With 
    End If 
     
exit_: 
     
    objWord.Visible = True 
    If Err Then MsgBox strFile & vbLf & Err.Description, vbCritical, "Error #" & Err.Number 
     
End Sub

The Excel bit - I need a FSO

This function for looping through the Sub folders
http://www.mrexcel.com/forum/excel-q...directory.html


Option Explicit

Public Sub Process_Files()
    
    Dim Fso As Scripting.FileSystemObject
    
    Set Fso = New Scripting.FileSystemObject
    Process_Files Fso, "C:\Users\DJ\Desktop\Files"     ' This folder has lots of sub folders
    
    Set Fso = Nothing

End Sub


Private Sub Process__Files(Fso As Scripting.FileSystemObject, folderPath As String)
   
    Dim Folder As Scripting.Folder, Subfolder As Scripting.Folder, File As Scripting.File
    Dim doc as document
    
    Set Folder = Fso.GetFolder(folderPath)
    
    For Each Subfolder In Folder.subfolders
        For Each File In Subfolder.Files
            If InStr(File.Name, ".docx") Then

           ' Merge the documents in each folder and create a new file based on folder name
          
            Call MergeDocs     ' Call the main procedure above ?

End If
        Next
    Next

End Sub

Now I have tried all sorts as always before posting for help - I also researched for help on VBA, but made lots of errors.

but I think i have drifted way too far offshore on this one - I will be humbly grateful for any assistance from the pro coders.

If I am on the wrong track please accept my apologies.

What I am trying to do :

In each folder there will be a set of my word files. I would like to merge each set of files - keeping the original formatting.
The new merged file name will be the Name of the folder.

thank you for your valuable time in advance.

I appreciate the time and help

DJ