WinBatch Tech Support Home

Database Search

If you can't find the information using the categories below, post a question over in our WinBatch Tech Support Forum.

TechHome

WinBatch
OLE COM ADO CDO ADSI LDAP
OLE with Excel
plus
Samples from Users

Can't find the information you are looking for here? Then leave a message over on our WinBatch Tech Support Forum.

Consolidate Excel Workbooks

Here's the prototype Consolidation script, that'll copy worksheets/cells/formulas and formatting over to the destination...

the order of the parameters don't matter, only that:

-d is followed by the destination filename and

-s is followed by ascending or descending

-s can be omitted

Filenames should be double-quoted so that ParseData will see them properly, especially if they have spaces in the path someplace...

for DOS command line: 

Consolidate.wbt -d "c:\data\excel\WB-Consol-Dest.xls" "c:\data\excel\WB1.xls" "c:\data\excel\WB2.xls" "c:\data\excel\WB3.xls" -s ascending
Thanks, Jay

CONSOLIDATEXL.WBT 

#DefineFunction iOpenExcel(wbname)
   Excel = ObjectOpen("Excel.Application")
   Excel.visible = @FALSE
   If wbname <> ""
      Excel.Workbooks.Open(wbname)
   Else
      Excel.Workbooks.add
   EndIf
   Return(Excel)
#EndFunction

#DefineFunction iInventoryWorksheets(wbobj)
   wsList = ""
   For w = 1 To wbobj.Worksheets.count
      wsList = ItemInsert(wbobj.Worksheets(w).name, -1, wsList, @LF)
   Next
   Return(wsList)
#EndFunction

#DefineFunction iCountWorksheets(xlfilename)
   xl = iOpenExcel(xlfilename)
   tws = xl.Workbooks(1).Worksheets.count
   xl.quit
   Return(tws)
#EndFunction

BoxOpen("Excel Consolidation", "Initializing...")

plist = ""
dsub = 0
ssub = 0

title = "XL Consolidation"
msg1  = "Destination file not specified...Terminating"
msg2  = "Must supply at least two source workbooks...Terminating"

For x = 1 To param0
   daparam = StrCat("param", x)
   plist = StrCat(plist, x, " ", %daparam%, @LF)
   If StrLower(%daparam%) == "-d" Then dsub = x+1
   If StrLower(%daparam%) == "-s" Then ssub = x+1
Next

If dsub                                 ; check for a destination file
   daparam = StrCat("param", dsub)
   dest_file = %daparam%
Else
   dest_file = "not specified"
   Terminate(@TRUE, title, msg1)
EndIf

If ssub                                 ; check for a sort type if any...
   daparam = StrCat("param", ssub)
   sort_type = %daparam%
Else
   sort_type = "not specified"
EndIf

iFiles = ""
For x = 1 To param0
;   we're only interested in the parameters that contain the input files,
;   the other parameters won't interfere if they're not there (value 0)
;   thanks to the check of the parameters on the first loop...
   If x == dsub   Then Continue
   If x == dsub-1 Then Continue
   If x == ssub   Then Continue
   If x == ssub-1 Then Continue
   daparam = StrCat("param", x)
   iFiles = ItemInsert(%daparam%, -1, iFiles, @LF)
Next

;   terminate script if there aren't at least two input files...
Terminate(ItemCount(iFiles, @LF) < 2, title, msg2)

;message("Debug", strcat("Destination File: ", dest_file, @crlf, "Sort Type: ", sort_type, @crlf, iFiles))

BoxText("Inventorying source files...")

;   first find out which of the source workbooks has the most worksheets in it
;   so that we speed up the processing, by copying that workbook to the destination
;   filename...

mws = 0
mws_pos = 0
For x = 1 To ItemCount(iFiles, @LF)
   thisfile = ItemExtract(x, iFiles, @LF)
   thiscount = iCountWorksheets(thisfile)      ; get a count of worksheets in the workbook...
   If thiscount > mws
      mws     = thiscount                     ; assign this count and position...
      mws_pos = x
   EndIf
Next

;message("Debug", mws_pos)
;   get the source file name from the position of the workbook with
;   the most sheets...
src_file = ItemExtract(mws_pos, iFiles, @LF)
;   if the destination exists delete it...
If FileExist(dest_file) Then FileDelete(dest_file)
;   copy the source to the destination...
FileCopy(src_file, dest_file, @FALSE)
;   remove the source since it's just been processed...
iFiles = ItemRemove(mws_pos, iFiles, @LF)

;message("Debug", iFiles)

btxt = "Starting copy..."
;display(1, "Debug", "Starting copy...")
BoxText(btxt)
;   open the destination workbook...
x_dest = iOpenExcel(dest_file)

;   loop thru the remaining input files and copy them
;   sheet by sheet to the destination...
For x = 1 To ItemCount(iFiles, @LF)
   thissrc = ItemExtract(x, iFiles, @LF)
   btxt = StrCat(btxt, @CRLF, "Processing file ", thissrc)
   BoxText(btxt)
   x_src = iOpenExcel(thissrc)
   x_src.displayalerts = @FALSE
   dest_wsnameList = iInventoryWorksheets(x_dest.Workbooks(1))
   For ws = 1 To x_src.Workbooks(1).Worksheets.count
      thisws   = x_src.Workbooks(1).Worksheets(ws)
      thisname = thisws.name
      btxt = StrCat(btxt, @CRLF, "Copying Worksheet ", thisname)
      BoxText(btxt)
      thisws.activate                                 ;activate the source ws...
      x_src.Workbooks(1).ActiveSheet.cells.select      ; select & copy everything...
      x_src.application.selection.copy
      ;
      x_dest.Workbooks(1).Worksheets.add               ;   add a new ws in the destination wb...
      x_dest.Workbooks(1).Worksheets(1).range("A1").select
      x_dest.Workbooks(1).ActiveSheet.paste
      x_dest.Workbooks(1).Worksheets(1).range("A1").select   ; paste it and select the first cell...
      ;
      If !ItemLocate(thisname, dest_wsnameList, @LF)         ; check for duplicate name...
         x_dest.Workbooks(1).Worksheets(1).name = thisname
      Else
         x_dest.Workbooks(1).Worksheets(1).name = StrCat(thisname, "_", x) ; if a duplicate add the file# as suffix...
      EndIf
      dest_wsnameList = iInventoryWorksheets(x_dest.Workbooks(1))  ; update the list of worksheet names in the destination...
   Next   ; worksheet
   btxt = StrCat(btxt, @CRLF)
   x_src.Workbooks(1).close
   x_src.quit
   x_src = 0
Next  ; input file

thisws = 0

If ssub
   BoxText("Sorting Destination...")
   dest_wsnameList = iInventoryWorksheets(x_dest.Workbooks(1))
   dest_wsnameList = ItemSort(dest_wsnameList, @LF)
   If StrSub(StrLower(sort_type), 1, 1) == "d"
      For x = 1 To ItemCount(dest_wsnameList, @LF)
         ThisName = ItemExtract(x, dest_wsnameList, @LF)
         ;   grab named worksheet, make it the first sheet...
         x_dest.Workbooks(1).Worksheets(ThisName).move(::Before=x_dest.Workbooks(1).Worksheets(1))
      Next
   EndIf
   If StrSub(StrLower(sort_type), 1, 1) == "a"
      For x = ItemCount(dest_wsnameList, @LF) To 1 By -1
         ThisName = ItemExtract(x, dest_wsnameList, @LF)
         ;   grab named worksheet, make it the first sheet...
         x_dest.Workbooks(1).Worksheets(ThisName).move(::Before=x_dest.Workbooks(1).Worksheets(1))
      Next
   EndIf
EndIf

BoxShut()

x_dest.Workbooks(1).Save()
x_dest.visible = @TRUE

x_src  = 0
x_dest = 0

Exit


    Sheets("Southwest").Select
    Cells.Select
    Selection.Copy

CallConsolidateXL.WBT 


;   you can comment out the various options to test the
;   parameter checking in the main wbt file...

@space = " "
params = ""
params = `-d "c:\data\excel\WB-Consol-Dest.xls"`
;params = strcat(params, @space, `"c:\data\excel\WB1.xls"`)
params = StrCat(params, @space, `"c:\data\excel\WB1.xls" "c:\data\excel\WB2.xls" "c:\data\excel\WB3.xls"`)
params = StrCat(params, @space, `-s ascending`)

;message("Debug", params)

wbt = StrCat(DirScript(), "ConsolidateXL.wbt")

Call(wbt, params)

Exit

;   here's the prototype Consolidation script, that'll copy worksheets/cells/formulas and formatting
;   over to the destination...

;   the order of the parameters don't matter, only that:
;   -d is followed by the destination filename
;   and
;   -s is followed by ascending or descending

;   -s can be omitted

;   filenames should be double-quoted so that ParseData will see them properly, especially if
;   they have spaces in the path someplace...

;   for DOS command line:
;   Consolidate.wbt -d "c:\data\excel\WB-Consol-Dest.xls" "c:\data\excel\WB1.xls" "c:\data\excel\WB2.xls" "c:\data\excel\WB3.xls" -s ascending

Article ID:   W17146

File Created: 2007:07:03:14:28:30
Last Updated: 2007:07:03:14:28:30