CODEWITHSUNDEEP
vbaexcelvbscript
user3216733
user3216733

Reputation: 35

VBS to compile information from multiple excel files into one

I'm working on VBScript to move all the information from multiple excel files into one sheet on a master excel file.

It would basically be 1000-2000 rows of information and about 20 columns. There would be about 5-6 total excel files in the directory. All of the information is on the first tab, I essentially just need to copy and paste it over without overwriting the previously copy and pasted data.

This is what I have so far, the issue I'm running into is that it copies over the previous excel sheets data in the master file with the most recent excel sheet's data. I need it to go to the next open cell.

Const xlFilterCopy = 2
Const xlUp = -4162
Const xlDown = -4121
strPathSrc = "C:\test" ' Source files folder
strMaskSrc = "*.xlsx" ' Source files filter mask
iSheetSrc = 1 ' Sourse sheet index or name
'iColSrc = 1 ' Source column index, e. g. 7 for "G"
strPathDst = "C:\test\Results\Results.xlsx" ' Destination file
'iColDst = 1 ' Destination column index

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkBookDst = objExcel.Workbooks.Open(strPathDst)
Set objSheetTmp = objWorkBookDst.Worksheets.Add
'objSheetTmp.Cells(1, iColDst).Value = "TempHeader"
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.NameSpace(strPathSrc)
Set objItems = objFolder.Items()
objItems.Filter 64 + 128, strMaskSrc
objExcel.DisplayAlerts = False
For Each objItem In objItems
    Set objWorkBookSrc = objExcel.Workbooks.Open(objItem.Path)
    Set objSheetSrc = objWorkBookSrc.Sheets(iSheetSrc)
    Set objRangeSrc = objSheetSrc.UsedRange
    Set ObjSheetDst = objWorkBookDst.Worksheets.Add
    objRangeSrc.AdvancedFilter xlFilterCopy, , objSheetDst.Cells(1, 1), False
    objSheetSrc.Delete
    objWorkBookSrc.Close
Next

Upvotes: 1

Views: 17386

Answers (2)

omegastripes
omegastripes

Reputation: 12612

Here you are!

strPathSrc = "C:\test" ' Source files folder
strMaskSrc = "*.xlsx" ' Source files filter mask
iSheetSrc = 1 ' Sourse sheet index or name
strPathDst = "C:\test\Results\Results.xlsx" ' Destination file
iSheetDst = 1 ' Destination sheet index or name

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkBookDst = objExcel.Workbooks.Open(strPathDst)
Set objSheetDst = objWorkBookDst.Sheets(iSheetDst)
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.NameSpace(strPathSrc)
Set objItems = objFolder.Items()
objItems.Filter 64 + 128, strMaskSrc
objExcel.DisplayAlerts = False
For Each objItem In objItems
    Set objWorkBookSrc = objExcel.Workbooks.Open(objItem.Path)
    Set objSheetSrc = objWorkBookSrc.Sheets(iSheetSrc)
    GetUsedRange(objSheetSrc).Copy
    Set objUsedRangeDst = GetUsedRange(objSheetDst)
    iRowsCount = objUsedRangeDst.Rows.Count
    objWorkBookDst.Activate
    objSheetDst.Cells(iRowsCount + 1, 1).Select
    objSheetDst.Paste
    objWorkBookDst.Application.CutCopyMode = False
    objWorkBookSrc.Close
Next

Function GetUsedRange(objSheet)
    With objSheet
        Set GetUsedRange = .Range(.Cells(1, 1), .Cells(.UsedRange.Row + .UsedRange.Rows.Count - 1, .UsedRange.Column + .UsedRange.Columns.Count - 1))
    End With
End Function

Upvotes: 2

tony b
tony b

Reputation: 1

You can use the macro recorder to record what you want.

Turn recording on. Press End key then Down Arrow (or whatever direction you want to go). Then down arrow again to the blank cell.

Look at your vba code and convert to vbs (macro recoder uses a experimental basic syntax that didn't take off so vbscript didn't support it).

Record the steps in excel macro recorder. You have to rewrite it a bit because it uses a type of syntax that vbs doesn't.

Here's an example

This applies (I don't have a medium9) xlRangeAutoFormatAccounting4 in vba.

Selection.AutoFormat Format:=xlRangeAutoFormatAccounting4, Number:=True, _
    Font:=True, Alignment:=True, Border:=True, Pattern:=True, Width:=True

So first look up constants in vba's object browser. eg; xlRangeAutoFormatAccounting4 = 17

Then look the function up in object browser and look at the bottom for the function definition,.

EG; Function AutoFormat([Format As XlRangeAutoFormat = xlRangeAutoFormatClassic1], [Number], [Font], [Alignment], [Border], [Pattern], [Width])

So the vba becomes in vbs (and vbs works in vba) (and as you can see you can work out the correct way without needing to look the function up usually)

Selection.AutoFormat 17, True, True, True,True, True, True

So your code becomes

objXLWs.Range("A3").CurrentRegion.Select.AutoFormat 17, True, True, True,True, True, True

Why would you do it in vbscript rather than vba. Using vba you can record large parts of your code and vbscript is legal vba syntax, so you can continue to write exactly the same code as in vbscript. VBA runs inprocess while vbs is out of proocess (slow - pretends to use a network to communicate). In VBA you can early bind (set xlApp = excel.application) rather than late bind (set xlapp = CreateObject("Excel.Application") as late binding requires a conversation before EVERY function call.

Upvotes: 0

Related Questions