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

Samples from Users

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

Combine XLS Workbooks using ADO

 Keywords: Combine Copy Excel XLS Workbooks ADO 

;Winbatch - combine data from 2 closed Excel workbooks into
;           new workbook using ADO
;
;Stan Littlefield July 25, 2009
;///////////////////////////////////////////////////////////////////

GoSub udfs
;///////////////////////////////////////////////////////////////////
;assumptions:
;files in the same folder
;Sheet name is same  -
;///////////////////////////////////////////////////////////////////


sheet="Sheet1"  ;common worksheet name
cXLS=DirScript():"TestCombine.xls" ;output Workbook



;you would probably select files from a listview
;for this exercise they are hard-coded

files=DirScript():"B2.xls":@TAB:DirScript():"B3.xls"

;create new workbook
crXL(1)


;iterate through the workbooks to combine and populate workbook
hdrs=0
row=2
nFiles=ItemCount(files,@TAB)
For j = 1 To nFiles
   cFile=ItemExtract(j,files,@TAB)
   If FileExist(cFile)  ;use ADO to collect data
      cConn = "Provider=MicroSoft.Jet.OLEDB.4.0; Data Source=":cFile:";Extended Properties=Excel 8.0"
      oRS = ObjectOpen("ADODB.Recordset")
      oRS.Open("SELECT * FROM [%sheet%$];",cConn,1,3,1)
      If ! oRS.eof
         crXL(2)
      EndIf
      oRS.Close()
      oRS=0
   Else
      Display(2,"File Not Found",cFile)
   EndIf
Next

;format output workbook
crXL(3)

Exit
;///////////////////////////////////////////////////////////////////


:udfs
#DefineSubRoutine crXL(mode)
;quick kludge, probably should use 3 different uds
If mode==2 Then Goto ins
If mode==3 Then Goto End

oXL = CreateObject("Excel.Application")
If oXL == 0 Then Return(0)

If FileExist(cXLS) Then FileDelete(cXLS)
oXL.Visible          = 1
oXL.ScreenUpdating   = 1
oXL.UserControl      = 1
oXL.DisplayAlerts    = 0
nOld = oXL.SheetsInNewWorkbook
oXL.SheetsInNewWorkbook = 1
oXL.WorkBooks.Add()
oXL.SheetsInNewWorkbook = nOld
oWS= oXL.ActiveWorkBook.WorkSheets(1)
oWS.Name="CombinedData"   ;can be changed as needed
Return(1)

:ins

If hdrs==0
   cc=oRS.Fields.Count
   r=1
   For i=0 To cc-1
      oWS.Cells(r,i+1).Value=oRS.Fields(i).Name
   Next
EndIf
nRecs = oRS.RecordCount
cRange = "A":row
oWS.Range(cRange).CopyFromRecordset(oRS)
row=row+nRecs

Return(1)

:End
;format the worksheet
col=oWS.UsedRange.Address
col=ItemExtract(2,col,":")
col=ItemExtract(2,col,"$")


;font and column width
oWS.UsedRange.Select()
oXL.Selection.Font.Name = 'Tahoma'
oXL.Selection.Font.Size = 9
oXL.Selection.Font.Bold = @TRUE

;use if needed
;oWS.UsedRange.Columns.Autofit()

;colorize header row and set autofilter
cRange = "A1:":col:"1"
oWS.Range(cRange).Select
oXL.Selection.Interior.ColorIndex = 6
oXL.Selection.Autofilter
oWS.Cells(1,1).Select()

oWS=0
oXL.ActiveWorkbook.SaveAs(cXLS)
;oXL.Quit()
oXL=0
Display(4,"Excel File Created",cXLS)
Return(1)
#EndSubRoutine


Return
;///////////////////////////////////////////////////////////////////

Article ID:   W18117
Filename:   Combine XLS Workbooks using ADO.txt
File Created: 2009:07:27:09:14:12
Last Updated: 2009:07:27:09:14:12