Modify - look at files within subfolders

S

Steph

Hello, thanks to the collaborative efforts of Tom Ogilvy and Bob Phillips, I
have the fantastic below piece of code (sub and function). They check all
files within a folder to see if the contents of cell A2 = 1. I was hoping
for some help on a slight change that would allow me to use this code for
another purpose in another workbook.

I would like to have the code look at all files AND all files within all
subfolders within a given folder. So right now the code looks for files in
C:\Test. Within C:\Test are several other sub-folders. I would like to
look in the subfolders as well. Can you help? Thanks in advance!!


Sub ProcessFiles()
Dim FSO As Object
Dim fldr As Object
Dim sFolder As String
Dim Folder As Object


Set FSO = CreateObject("Scripting.FileSystemObject")

sFolder = "C:\Test"

If sFolder <> "" Then
Set Folder = FSO.GetFolder(sFolder)
If FileCountOK(Folder) Then
Do_Stuff
End If
End If ' sFolder <> ""

End Sub

Function FileCountOK(pzFolder As Object)
Dim i As Long
Dim file As Object
Dim Files As Object

FileCountOK = True
Set Files = pzFolder.Files
For Each file In Files
If LCase(file) <> LCase(ThisWorkbook.FullName) Then
If file.Type = "Microsoft Excel Worksheet" Then
i = i + 1
Workbooks.Open Filename:=file.path
With ActiveWorkbook
FileCountOK = .ActiveSheet.Range("A2").Value = 1
.Close savechanges:=False
If Not FileCountOK Then Exit Function
End With
End If
End If
Next file

End Function
 
P

Philo Hippo

DoDir g_oFSO.GetFolder("C:\Test")

Sub DoDir(Folder)
On Error Resume Next
Dim File, SubFolder

For Each File In Folder.Files
Do_Stuff
Next

For Each SubFolder In Folder.SubFolders
DoDir g_oFSO.GetFolder(SubFolder),
SubFolder.Name
Next
End Sub
 
S

Steph

Hi Philo. Thanks for the response. Can your code be incorporated into my
function?
 
P

p

Public g_oFSO
Sub ProcessFiles()
Dim sFolder As String
CreateFSOobject
sFolder = "C:\Test"
If g_oFSO.FolderExists(sFolder ) Then
DoDir g_oFSO.GetFolder(sFolder )
End if
KillFSOobject
End Sub
Sub DoDir(Folder)
On Error Resume Next
Dim File, SubFolder
If FileCountOK(Folder) Then
For Each SubFolder In Folder.SubFolders
DoDir g_oFSO.GetFolder(SubFolder), _
SubFolder.Name
Next
End Sub

Public Sub CreateFSOobject()
On Error Resume Next
Set g_oFSO = CreateObject("Scripting.FileSystemObject")
End Sub
Public Sub KillFSOobject()
On Error Resume Next
Set g_oFSO = Nothing
End Sub

OK?
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top