Robb or anyone :) Macro Question

Posted by RoB on October 08, 2001 10:31 AM

This is the code you gave me to extract data from all excel files in a directory:

Sub Dtry()
Dim myFile As String, myCurrFile As String
myCurrFile = ThisWorkbook.Name
myFile = Dir("E:\Whatever Path\*.xls")
Do Until myFile = ""
Workbooks.Open "E:\Whatever Path\" & myFile
Workbooks(myCurrFile).Activate
Workbooks(myCurrFile).Worksheets("Sheet1").Range("A65536").End(xlUp).Activate
With ActiveCell
.Offset(1, 0) = Workbooks(myFile).Worksheets("Application").Range("AI4")
End With
Workbooks(myFile).Close savechanges:=False
myFile = Dir
Loop

End Sub

It works great, but I was wondering, if I have other directories in this directory, is there a way to get the data from ALL the sub directories in this main one automatically? or maybe with a mod? Thanks

Posted by Robb on October 10, 2001 3:26 AM

Rob

This should test for directories one level below ie. sub directories of
the one the original code searched. Required contents of the files in those
directories should then be returned. I have only gone 1 level down - you could
go further if you need.

Sub DtryB()
Dim myFile As String, myCurrFile As String, myDir As String, myDList() As String, myPath As String
Dim N As Integer
N = -1
myPath = "E:\Whatever Path\"
myCurrFile = ThisWorkbook.Name
myFile = Dir(myPath & "*.xls")
Do Until myFile = ""
Workbooks.Open myPath & myFile
Workbooks(myCurrFile).Worksheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0) = Workbooks(myFile).Worksheets("Application").Range("AI4")
Workbooks(myFile).Close savechanges:=False
myFile = Dir
Loop
myDir = Dir(myPath, vbDirectory)
Do Until myDir = ""
If myDir = "." Or myDir = ".." Or GetAttr(myPath & myDir) &LT;&GT; 16 Then GoTo Skip
N = N + 1
ReDim Preserve myDList(N)
myDList(N) = myDir
Skip:
myDir = Dir
Loop
For a = 0 To N
myFile = Dir(myPath & myDList(a) & "\*.xls")
Do Until myFile = ""
Workbooks.Open myPath & myDList(a) & "\" & myFile
Workbooks(myCurrFile).Worksheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0) = Workbooks(myFile).Worksheets("Application").Range("AI4")
Workbooks(myFile).Close savechanges:=False
myFile = Dir
Loop
Next a

End Sub

Does that help?

Regards

Posted by RoB on October 10, 2001 6:49 PM

GREAT Robb, ill give it a try, thanks