PDA

View Full Version : Find Excel workbooks in many SubFolders



Matrox
01-16-2007, 09:11 AM
Hi Guys,
Here I am again asking for your help.

I have in my code the excel sheets are in subfolders like:
c:\work\temp
\SubDir Grp_A
\SubDir GRP_A_APP\ "APP_xls files"
\SubDir GRP_A_PAM\ "PAM_xls files"

c:\work\temp
\SubDir Grp_B
\SubDir GRP_B_APP\ "APP_xls files"
\SubDir GRP_B_PAM\ "PAM_xls files"


I made one VBA code to each Grp,APP and PAm (same code n changing Private Const ctPathXLS = "c:\work\temp\SubDir Grp_X\SubDir GRP_X_XXX\".

How can I have it open the SubFolders to extract the datas from the excel in every folder by group, (APP,PAM) for example?
I specify tried this as I saw at this forum

Sub TryThis()
ShowAllFilesAllFoldersIn ("C:\work\temp")
End Sub
---
Sub ShowAllFilesAllFoldersIn(FolderPath)

Dim FolderFound As Object, File As Object

For Each FolderFound In CreateObject("Scripting.FileSystemObject") _
.GetFolder(FolderPath).SubFolders

Debug.Print FolderFound.Name

If Not FolderFound.Files.Count = 0 Then

For Each File In FolderFound.Files
If File.Name Like "*.xls" Then
'do what you want with the file here
Debug.Print vbTab & File.Name
End If
Next

End If
Next


But it didnt work:banghead: , that it can't find the others Subs and files name
is there anywhere around this

Once again, I hope to have any lights of you guys

Thanks in advance.
Ivan

lucas
01-16-2007, 10:02 AM
Hi Ivan,
Gilbar has a kb entry that works on a folder and all subfolders....it's for Word but you can probably adapt it:
http://vbaexpress.com/kb/getarticle.php?kb_id=76

post back if you have questions about it.

mdmackillop
01-16-2007, 12:03 PM
If the sheet name and cell address are consistent you could try
Option Explicit

Dim z As Long

Sub GetDataFromFiles()
Dim TopFolder As String, WS As String, CellAddress As String
Dim fs, i As Long
'Insert Folder, Sheet and Cell Address
TopFolder = "C:\AAA"
WS = "Sheet1"
CellAddress = "A1"

z = 1
Set fs = Application.FileSearch
With fs
.LookIn = TopFolder
.SearchSubFolders = True
.Filename = "*.xls"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
ProcessFiles .FoundFiles(i), WS, CellAddress
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub

Sub ProcessFiles(File As String, WS As String, CellAddress As String)
Dim MyPath As String, MyName As String
Dim Sheet As String, Address As String

'List Path and Workbook
MyName = Split(File, "\")(UBound(Split(File, "\")))
MyPath = Left(File, Len(File) - Len(MyName))

'Write results to Sheet1, Column A
Sheets(1).Cells(z, 1) = File
Sheets(1).Cells(z, 2) = GetData(MyPath, MyName, WS, CellAddress)
z = z + 1
End Sub

Private Function GetData(Path, File, Sheet, Address)
Dim Data As String
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
Range(Address).Range("A1").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function

Matrox
01-17-2007, 05:32 AM
Hi mdmackillop,

Good code, but I still hv a problem...

Need to make this:

- My root Dir c:\temp
-- Find the Dir_A
--- Find SubDir_A_PAM
---- Get xls files.
--Find Dir_B
--- Find SubDir_B_PAM
---- Get xls files.

When finish all Dir_"N" and SubDir_"N"_PAM

- Go Back to root c:\temp
-- Find Dir_A
--- Find SubDir_A_RAT
---- Get xls files.
--Find Dir_B
--- Find SubDir_B_RAT
---- Get xls files.



...and so on....

I need to group all xls files with the same Dir_"N" \ SubDir_"N" :help



Rgds
Ivan

mdmackillop
01-17-2007, 05:51 AM
If you know the number of sub levels (is it only one?), you can use the split function to insert the path elements into columns 1, 2 etc and sort on these results.
Sub ProcessFiles(File As String, WS As String, CellAddress As String)
Dim MyPath As String, MyName As String
Dim Sheet As String, Address As String
Dim i As Long
'List Path and Workbook
MyName = Split(File, "\")(UBound(Split(File, "\")))
MyPath = Left(File, Len(File) - Len(MyName))

'Write results to Sheet1, Column A
For i = 1 To 3
Folders File, i
Next
Sheets(1).Cells(z, 4) = GetData(MyPath, MyName, WS, CellAddress)
z = z + 1
End Sub


Sub Folders(File As String, i As Long)
On Error GoTo Exits
If UCase(Right(Split(File, "\")(i), 3)) <> "XLS" Then
Sheets(1).Cells(z, i) = Split(File, "\")(i)
End If
Exits:
End Sub

Matrox
01-17-2007, 07:12 AM
Hi mdmackillop,

You are fast , last than 15 minutes and here you are, cool.
Your help, as Lucas did in other post, help me a LOT to try to code in VBA. :bow: :bow:

:banghead: Thinking.......

ALMOST THERE my friend.:thumb
Thanks
Ivan