' This script changes the font color of excel spreadsheets
' 
' This script looks in the folder location strSearchLocation for files ending in .xls
'If it finds one then it opens it and changes the font color on each worksheet or the spreadsheet.
'The spreadsheet is then saved and the next one is opened.
'The script looks through all subfolders within the initial target folder.
'
'Modify strSearchLocation to change the search location
'Modify intFontColor to change font colors
'	NOTE: This changes the font color for ALL cells on all worksheets (that's the bad part)
'
'If a file is already open then this will not change that file (which is a good thing)
'The Internet Explorer window will record that file as having been changed. Not a big deal, I
'just didn't have time to code in that particular level of error checking.
'
' Created By David on 11/1/07


On error resume next		'This is needed in case one does not have rights to a particular folder

'Set up Constants
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>

'Change this to a directory that contains Excel files
strSearchLocation = "c:\ExcelFolder"

'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
intFontColor = xlAutomatic  'Automatic color
'intFontColor = 1			'Black


'HTML Message Variable
strMessage  = "<B>" & "Excel files found and recolored:" & "</B>" & "<BR>"

'Opens up IE to display messages
Set objIE = CreateObject("InternetExplorer.Application")
	objIE.Navigate("about:blank")
    objIE.ToolBar = 1
    objIE.StatusBar = 0
    Set objDoc = objIE.Document.Body
    objIE.Visible = True

'Bind to local services to search for files and open Excel
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Open up Excel
set objXL = CreateObject ("Excel.Application")

objXL.Visible = False  'Change if you want to see or not see the spreadsheets as they are changed

objXL.DisplayAlerts = False


'Call Subroutine to find and fix excel
objCurrentFolder = strSearchLocation
Sub_CheckFolder (objFSO.getfolder(objCurrentFolder))

'Close Excel
objXL.Quit



'This sub looks through the search folder and all subfolders to find excel files
Sub Sub_CheckFolder(objCurrentFolder)
	For Each objFile In objCurrentFolder.Files
	If LCase(Right(objFile.Name,4)) = ".xls" Then

		'Open spreadsheet
		Set objCurrentBook = objXL.Workbooks.Open(objFile.Path)
		objCurrentBook.Activate
		strMessage = strMessage & objFile.path & "<BR>"
		objDoc.InnerHTML = strMessage
		'Go through each worsksheet within the spreadsheet
		For Each objWorksheet in objCurrentBook.Worksheets
			objWorksheet.Cells.Font.ColorIndex = intFontColor
		Next
		objCurrentBook.Save
		objCurrentBook.Close
		
	End If
	Next
       '*** Recurse through all of the folders
       For Each objNewFolder In objCurrentFolder.subFolders
               Sub_CheckFolder (objFSO.getfolder(objNewFolder))
       Next
End Sub