Here's a VB script which will merge many
documents into one word doc, in filename
alphabetic order. TO use: put the code below
into a text file with suffix".vbs", and
create a folder called "docs" in the same
place where the .vbs script is. Place all the
docs you wnt to merge into the docs folder,
then drag it onto the .vbs file. The output
will be created in "docs_CONCATENATED.doc".
=========================================
'DOCmerge - merges several Word documents (.DOC files) together
'Author: George Birbilis (
[email protected]) / Zoomicon (
www.zoomicon.com)
'Version: 20080325
'On Error Resume Next
const ONLY_DOC = false 'set to true to allow concatenation only of .DOC files (not .TXT etc.)
const MSG_SYNTAX = "Drop a folder with Word (.DOC) documents onto this icon to produce a Word file with the concatenation of these documents"
const MSG_FINISHED = "" '"Finished"
const TXT_SUFFIX = "_CONCATENATED.doc"
const wdPasteDefault = 0
const wdPageBreak = 7
'----------------------------------------
dim word, fs, folderpath, outdocname, folder, outdoc
'----------------------------------------
'----------------------------------------
Sub ShowList( ByRef arrListName, ByVal strPrefix )
' Custom subroutine displaying the contents of an ArrayList on a
' single line, and the capacity and size on a separate second line.
' Arguments used are:
' arrListName: the name of the ArrayList to be displayed
' strPrefix: a short description to be displayed before the
' actual content of the ArrayList
Dim intLen, strItem, strList
' specify the maximum length of the descriptive text
intLen = 20
' save the ArrayList content to a string
For Each strItem in arrListName
strList = strList & " " & strItem
Next
' trim or pad the description to its maximum length, append the ArrayList content string, and display it
WScript.Echo Left( strPrefix & Space( intLen ), intLen ) & ": " & strList
' display the ArrayList's current size and capacity
WScript.Echo Left( "Count/Capacity" & Space( intLen ), intLen ) & ": " & arrListName.Count & "/" & arrListName.Capacity
End Sub
'-------------------------------------------------------
Sub ParseCommandLine
Dim args
Set args = wscript.arguments
if args.count = 0 then
msgbox MSG_SYNTAX
wscript.quit
end if
folderpath = args.item(0)
outdocname = folderpath + TXT_SUFFIX
End Sub
'----------------------------------------
Sub StartServers
'-- Start Word
Set word = CreateObject("Word.Application")
'word.Visible = true
Set fs = CreateObject("Scripting.FileSystemObject")
Set folder = fs.GetFolder(folderpath)
End Sub
'----------------------------------------
Sub DeleteOldOutput
If fs.FileExists(outdocname) Then
fs.DeleteFile(outdocname)
End If
End Sub
Sub ProcessFile(filename, insertBreak)
Dim doc
Set doc = word.Documents.Open(filename)
word.Selection.WholeStory
word.Selection.Copy
outdoc.Activate
if insertBreak then word.Selection.InsertBreak wdPageBreak
'word.Selection.PasteAndFormat wdPasteDefault
word.Selection.Paste 'use this one so that it works for Word2000 too
doc.Close
Set doc = Nothing
End Sub
Sub Process
DeleteOldOutput
Dim f, first
Dim Item
Dim outputLines
first = true
Set outputLines = CreateObject("System.Collections.ArrayList")
For Each f in folder.Files
if (ucase(right(f.path,4) ) = ".DOC" ) then
outputLines.Add f.name
'MsgBox f
end if
next
outputLines.Sort
ShowList outputLines, "output files"
For Each Item in outputLines
Dim fso, fileItem, filenm
Set fso = CreateObject("Scripting.FileSystemObject")
filenm = folderpath + "\" + Item
'MsgBox filenm 'uncomment this if you want to see the files as they are processed
Set fileItem = fso.GetFile(filenm)
if (not ONLY_DOC) or (ucase(right(fileItem.path,4)) = ".DOC") then
if first then
Set outdoc = word.Documents.Add
outdoc.SaveAs outdocname
ProcessFile fileItem.path, false
first = False
else
ProcessFile fileItem.path, true
end if
end if
Next
If Not first Then 'if at least one file was processed
outdoc.Save
outdoc.Close
End If
End Sub
'----------------------------------------
Sub Cleanup
Set outdoc = Nothing
word.Quit
Set word = Nothing
Set folder = Nothing
Set fs = Nothing
if MSG_FINISHED<>"" then MsgBox(MSG_FINISHED)
End Sub
'----------------------------------------
ParseCommandLine
StartServers
Process
Cleanup