Merge and split doc files

From ProZ.com Wiki

Jump to: navigation, search

Here's Terry's pair of macros to merge and split DOC files, as discussed here: http://www.proz.com/forum/office_applications/241546-merge_and_split_ms_word_files.html

Sub ConcatenateAllWordFiles()

'Combines all Word files in a directory into a single file called __MERGED__DOCS__.doc
'RUN THIS MACRO IN A NEW, EMPTY DOCUMENT

'This macro was written by Terry Richards unless it blows up and does ugly things
'to your computer, in which case I don't know who wrote it.
'It is supplied "as is" and it is entirely your own responsibility to confirm that
'it is adequate and suitable for your purposes. You run it entirely at your own risk.

Dim master, path As String

    'Prompt for the directory that contains the source files
    
    Dim dlgOpen As FileDialog
    Set dlgOpen = Application.FileDialog(FileDialogType:=msoFileDialogFolderPicker)
    
    'If the user didn't press cancel, go ahead and search this directory
    
    If dlgOpen.Show <> 0 Then
        
        'Save the selected path, generate the filename for the merged document and create it empty
        
        path = dlgOpen.SelectedItems(1)
        master = path + "\__MERGED__DOCS__.doc"
        ActiveDocument.SaveAs (master)
        
        'Now search all files in this directory
        
        With Application.FileSearch
        
            .NewSearch
            .LookIn = path
            .SearchSubFolders = False
            .FileName = "*.*"
            .Execute
            
            'For each file
            
            For i = 1 To .FoundFiles.Count
            
                'Is it a Word file? You can add other file types here (like RTF)
        
                If Right(.FoundFiles(i), 4) = ".doc" Or Right(.FoundFiles(i), 5) = ".docx" Then
                
                    'There are at least 2 files to be ignored -
                    'the one we are creating and any Word work file(s)
                
                    If .FoundFiles(i) <> master And InStr(.FoundFiles(i), "~$") = 0 Then
                    
                        'If we get this far, we have found a Word doc to merge into the new file
                        
                        'So open it
                        
                        Documents.Open FileName:=.FoundFiles(i), _
                        ConfirmConversions:=False, ReadOnly:=True, AddToRecentFiles:=False, _
                        PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
                        WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
                        wdOpenFormatAuto
                        
                        'Save the file name, copy the entire document to the clipboard and close it
                        
                        current = ActiveDocument.Name
                        Selection.WholeStory
                        Selection.Copy
                        Documents(current).Close
                        
                        'Insert a page break, the special magic cookie, and the full file name
                        
                        Documents(master).Activate
                        Selection.InsertAfter ("__%%FILE%%__: ")
                        Selection.EndKey Unit:=wdLine
                        Selection.InsertAfter (path)
                        Selection.EndKey Unit:=wdLine
                        Selection.InsertAfter ("\")
                        Selection.EndKey Unit:=wdLine
                        Selection.InsertAfter (current)
                        Selection.EndKey Unit:=wdLine
                        Selection.InsertBreak (wdPageBreak)
                        Selection.EndKey Unit:=wdLine
                        
                        'Paste the clipboard contents
                        
                        Selection.Paste
                        Selection.EndKey Unit:=wdLine
                        Selection.InsertBreak (wdPageBreak)
                    
                    End If
                    
                End If
        
            Next i
            
            'All documents processed, save the merge file
            
            ActiveDocument.Save
        
        End With

    End If
    
End Sub

Sub SplitAllWordFiles()

'Splits out a merge file created by ConcatenateAllWordFiles
'RUN THIS MACRO IN __MERGED__DOCS__.doc

'This macro was written by Terry Richards unless it blows up and does ugly things
'to your computer, in which case I don't know who wrote it.
'It is supplied "as is" and it is entirely your own responsibility to confirm that
'it is adequate and suitable for your purposes. You run it entirely at your own risk.

Dim FileName As String
Dim Content As Range

    'We work from the end of the document backwards
    'So first move to the end
    
    Selection.EndKey Unit:=wdStory
    Selection.Find.ClearFormatting
    
    'Set up a search for the magic cookie
    
    With Selection.Find
        
        .Text = "__%%FILE%%__: "
        .Replacement.Text = ""
        .Forward = False
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    
        'Search while there is still one found
        
        Do While .Execute() = True
        
            'Find the file name relative to the magic cookie and save it
            
            Selection.MoveRight Unit:=wdCharacter, Count:=1
            Selection.MoveEnd (wdParagraph)
            Selection.MoveEnd Unit:=wdCharacter, Count:=-1
            FileName = Selection
            
            'Delete the magic cookie line
            
            Selection.Expand (wdParagraph)
            Selection.Delete
            
            'Select from here to the end of the document
            'and cut the content to the clipboard
            
            Selection.MoveDown Unit:=wdLine, Count:=1
            Selection.EndKey Unit:=wdStory, Extend:=wdExtend
            Selection.Cut
            
            'Delete the extra page
            
            Selection.TypeBackspace
                   
            'Create a new empty document, paste the content into it,
            'save it with the original file name and close it.
            'NOTE: This will overwrite the original files in their original directory
            'This would be a good time to have a backup...
            
            Documents.Add DocumentType:=wdNewBlankDocument
            Selection.Paste
            ActiveDocument.SaveAs FileName:=FileName, FileFormat:= _
                wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
                True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
                False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
                SaveAsAOCELetter:=False
                
            ActiveDocument.Close
                            
        Loop
    
    End With

End Sub

Discussion related to this article

Please note that ProZ.com forum rules apply to this area.

Personal tools