NEED HELP!!!!

[Kiba]

Ok I need to update over a thousand workbooks. I have a macro that will do
it but I need to know how to make it look in the subfolders for .xl folders
instead of just the main. here's my code.

Sub WhiteWeights()
Dim Mypath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean

Dim Rng As Range



'Path to Folders where the files are.
Mypath = "X:\Daniel Wilson\Testing Foulder\Mill Work\Corner Bumper Guards"

'Add a slash at the end if the user forgot it
If Right(Mypath, 1) <> "/" Then
Mypath = Mypath & "/"
End If

'If there are no Excel Files in the folder exit the sub
FilesInPath = Dir(Mypath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found."
Exit Sub
End If

'Fill the array (myFiles) with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop


'Loop through all file in array
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(Mypath & MyFiles(Fnum))
On Error GoTo 0

If Not mybook Is Nothing Then

'Change cell value(s)
On Error Resume Next


'Experimental Coding

Application.DisplayAlerts = False
Application.ScreenUpdating = False

With mybook.Worksheets("Report")
Range("T78:AF80").Select
Selection.Font.ColorIndex = 2

Worksheets("Data Entry").Select
Range("c200:c203").Select
Selection.Font.ColorIndex = 2
Range("D200") = "Weights Font White"

Worksheets("Report").Select
Range("I2").Select
End With








If Err.Number > 0 Then
ErrYes = True
Err.Clear
'close without saving
mybook.Close savechanges:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Else
mybook.Close savechanges:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
Else
ErrorYes = True
End If

Next Fnum

End If

If ErrorYes = True Then
MsgBox "There are problems in one or more files, possible problem:" _
& vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
End If

With Application
.ScreenUpdating = True
.EnableEvents = True
End With




End Sub



Any help is appreciated.

 

[Joel]

I combined your code with one of my old macros. didn't fully tes the code
but I believe it should work. the code uses two subroutines to do recursive
searching on all subfolders.


Sub WhiteWeights()

' strFolder = "X:\Daniel Wilson\Testing Foulder\Mill Work\Corner Bumper
Guards"
strFolder = "c:\temp"
Set fso = CreateObject _
("Scripting.FileSystemObject")
Set Folder = _
fso.GetFolder(strFolder)

Call WhiteWeightsSubFolder(strFolder + "\")
End Sub

Sub WhiteWeightsSubFolder(strFolder)
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set Folder = _
fso.GetFolder(strFolder)

If Folder.subfolders.Count > 0 Then
For Each sf In Folder.subfolders
On Error GoTo 100
Call WhiteWeightsSubFolder(strFolder + sf.Name + "\")
100 Next sf
End If
'folder size in bytes
On Error GoTo 200
For Each fl In Folder.Files
Ext = fso.GetExtensionName(fl)
If UCase(Left(Ext, 2)) = "XL" Then

Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(fl)
On Error GoTo 0

If Not mybook Is Nothing Then

'Change cell value(s)
On Error Resume Next

'Experimental Coding

Application.DisplayAlerts = False
Application.ScreenUpdating = False

With mybook.Worksheets("Report")
Range("T78:AF80").Select
Selection.Font.ColorIndex = 2

Worksheets("Data Entry").Select
Range("c200:c203").Select
Selection.Font.ColorIndex = 2
Range("D200") = "Weights Font White"

Worksheets("Report").Select
Range("I2").Select
End With

If Err.Number > 0 Then
ErrYes = True
Err.Clear
'close without saving
mybook.Close savechanges:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Else
mybook.Close savechanges:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
Else
ErrorYes = True
End If
End If
Next fl
200 On Error GoTo 0

End Sub