Excel Search VBScript

excel_search.vbs

Set objFSO = CreateObject("Scripting.FileSystemObject")

objStartFolder = "C:\Users\s119588\Documents\TestReports\Test"

'*objStartFolder = "\\Share01\SP\Radiation-Survivability-Engineering\R&SE Section\Parts Database\ToSort\Daniel"

strExcelPath = "C:\Users\s119588\Desktop\results2.xlsx"
Set objExcel = CreateObject("Excel.Application")

objExcel.DisplayAlerts = False

objExcel.WorkBooks.add()
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

Dim RTOfile
RTOfile ="RPT"

Dim currentRow
currentRow = 1

'* CREATING THE XLSX HEADER ROW IN BOLD FONT
objSheet.Cells(currentRow, 1).Value = "Generic P/N"

objSheet.Cells(currentRow, 2).Value = "MFR"

objSheet.Cells(currentRow, 3).Value = "Lot ID"


objSheet.Cells(currentRow, 4).Value = "File Size (KB)"


objSheet.Cells(currentRow, 5).Value = "File Name"


objSheet.Range("1:1").Font.Bold=True
objSheet.Range("1:1").HorizontalAlignment = -4108

currentRow = currentRow +1

Set objFolder = objFSO.GetFolder(objStartFolder)


Dim fullFile
Set extDictionary = CreateObject("Scripting.Dictionary")
extDictionary.Add "xls", "xls"
extDictionary.Add "xlsx", "xlsx"
extDictionary.Add "xlsm", "xlsm"
set xlApp = createObject("Excel.Application")
xlApp.DisplayAlerts= False



For Each objFile in objFolder.Files

fullFile = objStartFolder & "\" & objFile.name
Call addROW()
WScript.Echo "Finished " & objFile.name   

Next


ShowSubfolders objFSO.GetFolder(objStartFolder)


Sub ShowSubFolders(Folder)

    For Each Subfolder in Folder.SubFolders

        Set objSubFolder = objFSO.GetFolder(Subfolder.Path)


        For Each objFile in objSubFolder.Files

 	fullFile= Subfolder.Path & "\" & objFile.name
	Call addROW()        
	Next


        ShowSubFolders Subfolder

    Next

End Sub



'* AUTOFIT COLUMNS
	for column = 1 to 5
  	 	objSheet.columns(column).AutoFit()
	next

objExcel.ActiveWorkbook.SaveAs(strExcelPath)
objExcel.ActiveWorkbook.Close

objExcel.Application.Quit

'* addROW() FUNCTION EXTRACTS REQUESTED INFO TO PASTE IN XLSX TABLE
Function addROW()
    If (extDictionary.Exists(LCase(objFSO.GetExtensionName(objFile.name))) And InStr(Ucase(objFile.name), RTOfile) ) Then
		On Error Resume Next
		set Excelbook = xlApp.Workbooks.open(fullFile, False, True)
			If err.number <> 0 Then
				Wscript.Echo "The file " & fullFile & " cannot be opened."
			Else 
				set Excelworksheet = Excelbook.worksheets(1)
				'* POPULATE GENERIC P/N
				objSheet.Cells(currentRow, 1).value = Excelworksheet.Cells(4,5).Value

				'* POPULATE MFR
				objSheet.Cells(currentRow, 2).value = Excelworksheet.Cells(3,9).Value

				'* POPULATE LOT ID
				objSheet.Cells(currentRow, 3).value = Excelworksheet.Cells(4,9).Value

				'* POPULATE FILE SIZE
				objSheet.Cells(currentRow, 4).Value = Round(objFile.size/1024) 
				'* POPULATE FILE NAME W/ URL
				objSheet.Cells(currentRow, 5).Value = "=HYPERLINK(""" & fullFile & """,""" & fullFile & """)"
				objSheet.rows(currentRow).HorizontalAlignment = -4131
			End If
  	 		

	Excelbook.Close
	currentRow = currentRow+1

    End If

    On error GoTo 0	
End Function

RecursiveFileFinder.vbs

Class RecursiveFileFinder
	Private mFileSystemObject
	Private mSearchFolder
	Private mFilesRetrievedCount
	Dim mFilesRetrieved()


	Private Sub Class_Initialize()
		Set mFileSystemObject = CreateObject("Scripting.FileSystemObject")
		Set mFilesRetrievedCount = 0
	End Sub

	Public Property Let searchFolder(pSearchFolder)
		mSearchFolder = pSearchFolder
	End Property

	Public Function getFiles()
		Set recursiveFolderObject = mFileSystemObject.GetFolder(mSearchFolder)
		
		For Each fileObject in recursiveFolderObject.Files
			fullFile = mSearchFolder & "\" & fileObject.name
			ReDim mFilesRetrieved(mFilesRetrievedCount + 1)
			mFilesRetrieved(mFilesRetrievedCount) = fullFile
			mFilesRetrievedCount = mFilesRetrievedCount+1

			WScript.Echo "Found File: " & fullFile
		Next


		iterateSubFolder(recursiveFolderObject)

		getFiles = mFilesRetrieved
	End Function

	Private Sub iterateSubFolder(folder)
		For Each Subfolder in folder.SubFolders
			Set objSubFolder = mFileSystemObject.GetFolder(Subfolder.Path)

			For Each fileObject in objSubFolder.Files

				fullFile= Subfolder.Path & "\" & fileObject.name

				ReDim mFilesRetrieved(mFilesRetrievedCount + 1)
				mFilesRetrieved(mFilesRetrievedCount) = fullFile
				mFilesRetrievedCount = mFilesRetrievedCount+1

				WScript.Echo "Found File: " & fullFile    
			Next
			iterateSubFolder(Subfolder)
		Next
	End Sub
End Class

RetrieveRTOFiles.vbs

'* Define an include subroutine for including other class files
Sub includeFile(file)
  Dim fso, f
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set f = fso.OpenTextFile(file, 1)

  str = f.ReadAll
  f.Close
  ExecuteGlobal str
End Sub
'* Include all the classes we need
includeFile("RecursiveFileFinder.vbs")

'* Set the variables we will use
Dim fileFinder
objStartFolder = "C:\Users\s119588\Documents\TestReports\Test"
'*objStartFolder = "\\Share01\SP\Radiation-Survivability-Engineering\R&SE Section\Parts Database\ToSort\Daniel"

strExcelPath = "C:\Users\s119588\Desktop\results2.xlsx"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objExcel = CreateObject("Excel.Application")

objExcel.DisplayAlerts = False

objExcel.WorkBooks.add()
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

Dim RTOfile
RTOfile ="RPT"

Dim currentRow
currentRow = 1

'* CREATING THE XLSX HEADER ROW IN BOLD FONT
objSheet.Cells(currentRow, 1).Value = "Generic P/N"
objSheet.Cells(currentRow, 2).Value = "MFR"
objSheet.Cells(currentRow, 3).Value = "Lot ID"
objSheet.Cells(currentRow, 4).Value = "File Size (KB)"
objSheet.Cells(currentRow, 5).Value = "File Name"
objSheet.Range("1:1").Font.Bold=True
objSheet.Range("1:1").HorizontalAlignment = -4108

currentRow = currentRow +1

'* Setup a dictionary with the correct extensions
Set extDictionary = CreateObject("Scripting.Dictionary")
extDictionary.Add "xls", "xls"
extDictionary.Add "xlsx", "xlsx"
extDictionary.Add "xlsm", "xlsm"

'* This object is for opening the Excel files
set xlApp = createObject("Excel.Application")
xlApp.DisplayAlerts= False

'* Let's grab all the files
Set fileFinder = New RecursiveFileFinder
fileFinder.searchFolder = objStartFolder
files = fileFinder.getFiles()
'* Iterate over the files and create the Excel
For Each fileName in files
	Set objFile = objFSO.GetFile(fileName)
	If (extDictionary.Exists(LCase(objFSO.GetExtensionName(fileName))) And InStr(Ucase(fileName), RTOfile) ) Then
		On Error Resume Next
		Set Excelbook = xlApp.Workbooks.open(fileName, False, True)
			If err.number <> 0 Then
				Wscript.Echo "The file " & fileName & " cannot be opened."
			Else 
				set Excelworksheet = Excelbook.worksheets(1)
				'* POPULATE GENERIC P/N
				objSheet.Cells(currentRow, 1).value = Excelworksheet.Cells(4,5).Value

				'* POPULATE MFR
				objSheet.Cells(currentRow, 2).value = Excelworksheet.Cells(3,9).Value

				'* POPULATE LOT ID
				objSheet.Cells(currentRow, 3).value = Excelworksheet.Cells(4,9).Value

				'* POPULATE FILE SIZE
				objSheet.Cells(currentRow, 4).Value = Round(objFile.size/1024) 
				'* POPULATE FILE NAME W/ URL
				objSheet.Cells(currentRow, 5).Value = "=HYPERLINK(""" & fileName & """,""" & fileName & """)"
				objSheet.rows(currentRow).HorizontalAlignment = -4131
			End If
  	 		
		WScript.Echo "Finished " & objFile.name
		Excelbook.Close
		currentRow = currentRow+1

    End If
Next

TestRecursiveFileFinder.vbs

Sub includeFile(file)
  Dim fso, f
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set f = fso.OpenTextFile(file, 1)

  str = f.ReadAll
  f.Close
  ExecuteGlobal str
End Sub

includeFile("RecursiveFileFinder.vbs")

Dim fileFinder
Set fileFinder = New RecursiveFileFinder
fileFinder.searchFolder = "C:\Users\s119588\Documents\TestReports\Test"
files = fileFinder.getFiles()