Not able to run vbscript on windows 7 and above version

Question

I am not able to run a vbscript on windows 7 and above version. This script basically is used to copy data from one excel workbook to another. Please help me.

Thanks.

option explicit
on error resume next

dim objexcel,objfso,objfolder,objsubfolder,objfile,objrange
dim objworkbook,objworkbook2,objworksheet
dim strpath,pathname,endroww,introw,k,i
dim intnewrow,startrow,endrow
dim objrange1,objrange2

'constants asigned to sort
Const xlAscending = 1
Const xlYes = 1

Set objExcel = CreateObject("Excel.Application")

intnewrow=1

strPath = "C:\Documents and Settings\SupriyaS\Desktop\feb 141"
pathName="xls"

If strPath = "" then Wscript.quit
If pathName = "" then Wscript.quit

'Creating an Excel Workbook in My Documents(destination)
Set objWorkbook2= objExcel.Workbooks.Add()

'to supress the flashing oh the screens
objExcel.Visible = False

'to supress the dialog box
objExcel.DisplayAlerts = False

Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder (strPath)
Set objsubFolder = objfolder.subFolders
set objfile = objsubfolder.files

'loop through all the subfolders
For Each objsubfolder in objfolder.subfolders

'loopt hrough all the excel files in subfolder
For Each objFile In objsubFolder.Files

'to check for excel files using extention
If objFso.GetExtensionName (objFile.Path) = "xls" Then

'open the workbook to be copied from(source)
Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)

'activate the worksheet
Set objWorksheet = objWorkbook.WorkSheets(1)
objworksheet.Activate

'copy from the 2nd row 
If intNewRow = 1 Then
startrow = 1
Else
startrow = 2
End If

'count the number of used row
endrow = objWorkbook.Worksheets("SHEET1").UsedRange.Rows.Count

'copy the data
objWorkbook.Worksheets("SHEET1").Range(startrow & ":" & endrow).Copy

'close the workbook after copying
objWorkbook.close

'paste it on workbook2
objWorkbook2.Worksheets("Sheet1").Cells(intNewRow,1).PasteSpecial

'increment the row
intNewRow = intNewRow + (endrow - startrow + 1)

End If
Next
Next

'counting row of workbook2
endroww = objWorkbook2.Worksheets("SHEET1").UsedRange.Rows.Count

'Deleting empty rows w.r.t column A (Sl.no)
while endroww >= 2   
if objworkbook2.worksheets("sheet1").cells(endroww,1).value = "" then 
Set objRange = objworkbook2.worksheets("sheet1").Cells(endroww,1).EntireRow
objrange.delete
end if 
endroww = endroww -1 
Wend   

'Sorting the data w.r.t date in ascending order
Set objWorksheet2 = objWorkbook2.Worksheets(1)
Set objRange1 = objWorksheet2.UsedRange
Header = xlYes
Set objRange2 = objExcel.Range("d2")
objRange2.Sort objRange2,xlAscending,,,,,,xlYes

'counting rows of workbook2 after deleting
k = objWorkbook2.Worksheets("SHEET1").UsedRange.Rows.Count

'Editing Serial number
introw = 2
for i = 1 to k
objworkbook2.worksheets("sheet1").cells(introw,1).value = i
introw = introw + 1
next

'save and close workbook2
objworkbook2.save
objworkbook2.close

This is the script and it will loop through all the subfolder and copy's the data from the excel workbooks in the sub folder to a single workbook. when i run the code it runs but i am not getting the excepted output i,e., its not copying the data at all and i am not getting any error while running the code.

Answer 1

You need to comment out that line.

on error resume next 

by

'on error resume next 

Then you'll get an error number, line number, and column nnumber of the error.

Answer 2

on error resume next

turns off error checking.

If you turn off error checking then you need to do it yourself. So after any line that may generate an error

If err.number <> 0 then
    Fix_the_error
    err.clear
End If