PDA

View Full Version : open 'xl*' files from sub folders without naming them



omp001
10-25-2011, 04:04 AM
Hi all.

I'm using the code below to open all files '.xl*' from a folder (MyFolder).
However I have many sub folders level1 (about 25 of them) and many sub folders level2 (about 120).
How could I go with a code to open all '.xl*' files from MyFolder, from SubFolderLevel1 and from SubFolderLevel2 without needing to write the name of all that sub folders?
using XL 2007

something like:
myPath1="C:\MyFolder\"
myPath2="C:\MyFolder\*\"
myPath3="C:\MyFolder\*\*\"

Sub OpenAllXL()
Dim myFiles, myPath As String
myPath = "C:\MyFolder\SubFolderLevel1\SubFolderLevel2\"
myFiles = Dir(myPath)
Do While myFiles <> ""
If myFiles Like "*.xl*" Then
Workbooks.Open myPath & myFiles
End If
myFiles = Dir
MsgBox myFiles
Loop
End Sub
thnks in advance

omp001
10-26-2011, 08:25 AM
Bump.
Could someone help me with this?
Thanks to all.

Kenneth Hobs
10-26-2011, 08:44 AM
Here is an FSO method. Modify to open in the For loop line with Debug.

Sub Test_SearchFiles()
Dim v As Variant, a() As Variant
SearchFiles ThisWorkbook.Path, "*.xl*", 0, a(), True
For Each v In a()
Debug.Print v
Next v
End Sub

'http://www.ozgrid.com/forum/showthread.php?t=157939
Private Function SearchFiles(myDir As String _
, myFileName As String, n As Long, myList() _
, Optional SearchSub As Boolean = False) As Variant
Dim fso As Object, myFolder As Object, myFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
For Each myFile In fso.getfolder(myDir).Files
Select Case myFile.Attributes
Case 2, 4, 6, 34
Case Else
If (Not myFile.Name Like "~$*") _
* (myFile.Path & "\" & myFile.Name <> ThisWorkbook.FullName) _
* (UCase(myFile.Name) Like UCase(myFileName)) Then
n = n + 1
ReDim Preserve myList(1 To 2, 1 To n)
myList(1, n) = myDir
myList(2, n) = myFile.Name
End If
End Select
Next
If SearchSub Then
For Each myFolder In fso.getfolder(myDir).subfolders
SearchFiles = SearchFiles(myFolder.Path, myFileName, _
n, myList, SearchSub)
Next
End If
SearchFiles = IIf(n > 0, myList, CVErr(xlErrRef))
End Function

omp001
10-26-2011, 08:59 AM
Many thanks Ken.
I'll give it a try later.
Thnks again.