Accessing Excel files within multiple levels of a directory

[Barb Reinhardt]

Let's say I have a directory structure like this:

FOLDER1
FOLDER 1A
FOLDER 1A1
FOLDER 1A2
FOLDER 1B
FOLDER 1B1
FOLDER 1B2

I want to be able to select a high level folder and then open all XLS
workbooks that are in every folder below it. I'm not even sure how to begin
with this.

Also, I think I've seen somewhere that there's a way to allow the user to
CANCEL during execution of a macro. How do I do that?

Thanks in advance,
Barb Reinhardt

 

[Jim Thomlinson]

You kinda have two questions here so lets start with the first. Here is some
code to look through folders and subfolders. Place this code in a standard
code module in a new workbook. (The code is compiled from a bunch of other
posts from Bob Phillips and others if I recall correctly but any errors would
undoubtedly be my own.)

Option Compare Text

Sub test()
Call ListFiles("H:\", Sheet2.Range("A2"), "xls", True)
End Sub

Public Sub ListFiles(ByVal strPath As String, _
ByVal rngDestination As Range, Optional ByVal strFileType As String = "*", _
Optional ByVal blnSubDirectories As Boolean = False)
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim strName As String

'Specify the file to look for...
strName = "*." & strFileType
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPath)

For Each objFile In objFolder.Files
If objFile.Name Like strName Then
rngDestination.Value = objFile.Path
rngDestination.Offset(0, 1).Value = objFile.DateLastAccessed
Set rngDestination = rngDestination.Offset(1, 0)
End If
Next 'objFile
Set objFile = Nothing

'Call recursive function
If blnSubDirectories = True Then _
DoTheSubFolders objFolder.SubFolders, rngDestination, strName

Set objFSO = Nothing
Set objFolder = Nothing
End Sub


Function DoTheSubFolders(ByRef objFolders As Object, _
ByRef rng As Range, ByRef strTitle As String)
Dim scrFolder As Object
Dim scrFile As Object
Dim lngCnt As Long

On Error GoTo ErrorHandler
For Each scrFolder In objFolders
For Each scrFile In scrFolder.Files
If scrFile.Name Like strTitle Then
rng.Value = scrFile.Path
rng.Offset(0, 1).Value = scrFile.DateLastAccessed
Set rng = rng.Offset(1, 0)
End If
Next 'scrFile

'If there are more sub folders then go back and run function again.
If scrFolder.SubFolders.Count > 0 Then
DoTheSubFolders scrFolder.SubFolders, rng, strTitle
End If
ErrorHandler:
Next 'scrFolder

Set scrFile = Nothing
Set scrFolder = Nothing
End Function


Question 2 - How to interupt code... you can try something similar to this...

Dim lng As Long
Dim counter As Long
On Error GoTo ErrorHandler
Application.EnableCancelKey = xlErrorHandler

For lng = 1 To 100000000
counter = counter + 2
Next lng
ErrorHandler:
If Err = 18 Then
If MsgBox("Do you want to stop?", vbYesNo, "Quit?") = vbYes Then
MsgBox counter
Exit Sub
Else
Resume
End If
Else
MsgBox counter
End If

 

[Bryan Loeper]

You'll want to write a function that takes a directory name, puts
together a list of all directories in it, calls itself for each of
those directories, then opens all the files in that directory. You'll
end up with all files in folder 1A1 opened first, then 1A2, then 1A,
then 1B1, then 1B2, then 1B, then 1.

Public Function OpenBigDir(DirName As String)
'Get array of directories under DirName
'If array contains more than zero directories
For each Dir in DirArray
OpenBigDir(Dir)
Next Dir
'Get array of files.
'If array contains more than zero files
For each File in Filearray
Open File
Next file
End Function

Let me know if you need more help than that.

 

[Dave Peterson]

You could use application.filesearch. But that goes away in xl2007--and it's
kind of flakey in earlier versions.

Ron de Bruin has converted many of his sample macros to use FSO
(FileSystemObject). It seems to work fine for him (and others <bg>).

http://www.rondebruin.nl/fso.htm

 

[Barb Reinhardt]

Thanks. It's going to take me a bit to digest this.