rocksolidsr
Programmer
I'm trying to parse multiple excel files in multiple sub-directories and I'm only looking for a few cells in one row of the excel files, once I find the cells I would like to be able to copy them and paste them into an excel file that keeps all the data. I have the following code that does it for just one file
The reason for this, is because every time a test is ran one of these excel files is created for each test, but I would like all the relevant data in one file for better statistical data analysis.
The cells I want to extract are B28, C28, D28, E28, F28, G28
I've attached the excel spreadsheet that I will be parsing.
any help would be appreciated. thanks.
The reason for this, is because every time a test is ran one of these excel files is created for each test, but I would like all the relevant data in one file for better statistical data analysis.
The cells I want to extract are B28, C28, D28, E28, F28, G28
Code:
Option Explicit
Dim objExcel, strExcelPath, objSheet, intRow, serialnumber, res_freq
Dim anti_res_freq, freq_diff, i_at_res, r_at_res, objExcel2, strNewFile, objSheet2
' Bind to Excel object.
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Excel application not found."
Wscript.Quit
End If
On Error GoTo 0
'Need to read all excel files in all subdirectories
strExcelPath = "C:\Documents and Settings\srock\Desktop\Excel Scripts\Imp_Test_Data_2009_Realibility Test 1.xls"
' Open specified spreadsheet and select the first worksheet.
objExcel.WorkBooks.Open strExcelPath
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
' Iterate through the rows of the spreadsheet after the first, until the
' first blank entry in the first column. For each row, bind to the user
' specified in the first column and set attributes.
intRow = 28
Do While objSheet.Cells(intRow, 1).Value <> ""
serialnumber = objSheet.Cells(intRow, 2).Value
res_freq = objSheet.Cells(intRow, 3).Value
anti_res_freq = objSheet.Cells(intRow, 4).Value
freq_diff = objSheet.Cells(intRow, 5).Value
i_at_res = objSheet.Cells(intRow, 6).Value
r_at_res = objSheet.Cells(intRow, 7).Value
On Error Resume Next
intRow = intRow + 1
Loop
'Create New File with appended data
strNewFile = "C:\Documents and Settings\srock\Desktop\Excel Scripts\UserGroup.xls"
' Bind to Excel object.
On Error Resume Next
Set objExcel2 = CreateObject("Excel.Application")
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Excel application not found."
Wscript.Quit
End If
On Error GoTo 0
' Create a new workbook.
objExcel2.Workbooks.Add
Set objSheet2 = objExcel2.ActiveWorkbook.Worksheets(1)
objSheet2.Name = "User Groups"
' Populate spreadsheet cells with user attributes.
objSheet2.Cells(2, 1).Value = serialnumber
objSheet2.Cells(2, 2).Value = res_freq
objSheet2.Cells(2, 3).Value = anti_res_freq
objSheet2.Cells(2, 4).Value = freq_diff
objSheet2.Cells(2, 5).Value = i_at_res
objSheet2.Cells(2, 6).Value = r_at_res
' Save the spreadsheet and close the workbook.
objExcel2.ActiveWorkbook.SaveAs strNewFile
objExcel2.ActiveWorkbook.Close
' Quit Excel.
objExcel2.Application.Quit
' Close workbook and quit Excel.
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
' Clean up.
Set objExcel = Nothing
Set objSheet = Nothing
'Set objUser = Nothing
Wscript.Echo "Done"I've attached the excel spreadsheet that I will be parsing.
any help would be appreciated. thanks.
