Opening workbooks in several Folder

[almouchie]

I have this in my code
Workbooks.Open Filename:="M:\G-R\2006\Jan 06\" & ActiveCell & ".xls"

my excel sheets are in folder by month as in jan 06, feb 06, & so on

how can I have it open the excel sheets to extract the data from 2006 in every folder
becoz if I specify the folder jan 06 it will not open other excel sheets in different folder, & I tried not to specify any folder
but it didnt work, gave me error, that it cann't find the file name

is there anywhere around this

[Killian]

You'll have to build a string for the path of each file then run the open command with it

There are a number of options available for how to build the string...
One option is to build the path using the same logic you use in the file structure and manipulate the date part (see the output in the immediate window - Ctrl+G)Sub MakePaths()

Const PATH_ROOT As String = "M:\G-R\"
Dim FILENAME As String
Dim i As Long
FILENAME = "\" & ActiveCell & ".xls"

'return folder name for current month
Debug.Print PATH_ROOT & _
Format(Now(), "yyyy") & "\" & Format(Now(), "MMM yy") & _
FILENAME

'return folder name for the previous six months
For i = -1 To -6 Step -1
Debug.Print PATH_ROOT & _
Format(DateAdd("m", i, Now()), "yyyy") & "\" & _
Format(DateAdd("m", i, Now()), "MMM yy") & _
FILENAME
Next

End SubNow you will, of course, get an error if for some reason the folder you are expecting to be there isn't or has been named incorrectly. You can choose just to skip these errors with "On Error Resume Next" before your Open command if thats an acceptable approach

Alternatively, you can use the DIR command or FileSystemObject to go and get each existing folder/file. Using the FileSystemObject (FSO) means we can do some validation and produce a more robust procedure.
Again, I'm outputting path strings to the Immediate windowSub MakePaths2()

'!!! Go to Tools>References and add a reference to
'!!! the Microsoft Scripting Runtime

Const PATH_ROOT As String = "M:\G-R\2006\"
Dim FILENAME As String
Dim fso As FileSystemObject
Dim fldrYear As Folder
Dim fldrMonth As Folder
Dim f As File

FILENAME = "\" & ActiveCell & ".xls"
Set fso = New FileSystemObject
Set fldrYear = fso.GetFolder(PATH_ROOT)

For Each fldrMonth In fldrYear.SubFolders
If fso.FileExists(fldrMonth.Path & FILENAME) Then
Debug.Print "Found file: " & fldrMonth.Path & FILENAME
Else
Debug.Print fldrMonth.Path & FILENAME & " not found"
End If
Next fldrMonth

End SubHope that helps

[almouchie]

THanks for ur reply
I am not too sure I understand what ur saying:dunno
when I tried incorporating what u said I have errors

this is the codeSub GetData()
Dim TgtCol
Dim Source
Dim Data()
Dim WB As Workbook

Dim hnow1 As Date
Dim hnow2 As Date
hnow1 = Now
hbeg = Format(hbeg, "h:mmm:ss")
hend = Format(hend, "h:mm:ss")
Application.ScreenUpdating = False
Set WB = ThisWorkbook
TgtCol = Array(2, 3, 5, 7, 9, 11)
ReDim Data(UBound(TgtCol))
Source = Array("B2", "B3", "D7", "E7", "f7", "G7")
Range("A3").Select
Do Until ActiveCell = ""
Workbooks.Open Filename:="M:\G-R\Jan 06\" & ActiveCell & ".xls"
Sheets("Sheet2").Activate
For i = 0 To UBound(TgtCol)
Data(i) = Range(Source(i)).Value
Next
ActiveWorkbook.Close False
WB.Activate
Sheets("Sheet1").Activate
For i = 0 To UBound(TgtCol)
Cells(ActiveCell.Row, TgtCol(i)) = Data(i)
Next
ActiveCell.Offset(1).Select
Loop
Application.ScreenUpdating = True
Range("M3").Select
ActiveCell.FormulaR1C1 = "=RC[-8]+RC[-6]*2+RC[-4]+RC[-2]*2"
Range("M3").Select
Range([B3], [B3].End(xlDown)).Offset(, 11).FillDown


hnow2 = Now
MsgBox (hnow2 - hnow1 & "seconds")

End Subhow can I apply what ur saying to it
the main folder G-R has folders for each month that contain the workbooks I am getting my info from

Thanks:hi: