Reading Excel files in folder/subfolders

Hi!

I need some help reading out information from multiple excel files in folder/subfolders.
The structure of the folders are /year/month/file
So if it's a file from this month it would be /2014/Februar/test.xlsx
I need to read all the files within this month and next month.

I've attached a sample file which the information needs to be put in. under "Data" there's a table, i need to input the information from the files that are read.

From the source file in question

• Column A = C5
• Column B = C7 with a link to the file which it's from
• Column C = C110
• Column D = F16
• Column E = F10
• Column F = F7
• Column G = F8

Hope this is clear and hope I can get some input on this, I'm pretty lost unfortunatly :/
This has to be run when opening the "kalender.xlsx"

Do the labels (merged cells) on the Kalendar Sheet represent command button to pull the data for the particular month?

In column B, you indicate that this should be a link to the file. Where is this coming from? In your example, it does not look like the file name as shown in the posting. Please clarify. Because the year will change and your folder will change, how do you wish to prompt for the year? Input Box popup, or will you populate a cell on the Kalendar sheet?

Understand. One more question. Will you ever run the report for the latest month (February) in March. Using Current Month means that you will have to run report for February in February. Please clarify as you use the term current month and I want to make sure of this.

Starting writing code and realized I still have another question. This statement

I need to read all the files within this month and next month.

Will there be more than one file per month?

here is a starting point:

yYear = Year(Now())
    If Month(Now()) = 12 Then
        nextm = MonthName(1)
        yYear = yYear + 1
    Else
        mMonth = MonthName(Month(Now()))
    End If
        
    path = "C:\" & yYear & "\" & mMonth & "\"
     
    excelfile = Dir(path & "*.xls")
    Do While excelfile <> ""
        Workbooks.Open Filename:=path & excelfile
        LastusedRow = ActiveSheet.UsedRange.Rows.Count
        
'''''''''''''''''''''
''' COPYING CODE HERE 
'''''''''''''''''''''       
        excelfile = Dir
    Loop

try this for hyperlink

ActiveSheet.Hyperlinks.Add Range("B" & LastusedRow), Path & excelfile, TextToDisplay:=TextToDisplay

Paste here the entire code you're using now pls.

@crakter,
My apologies for not responding earlier. I had been locked out of the forum for the last 24 hours due to an electronic issue. Any way, here is my code for your issue.

Option Explicit

Sub Calendar()
'Declare and set Variables
    Dim cTarg As Workbook
    Dim nTarg As Workbook
    Dim Dest As Workbook
    Set Dest = ThisWorkbook
    Dim ws As Worksheet, ws2 As Worksheet
    Set ws = Dest.Sheets("Data")
    Dim lr As Long
    Dim cMnth As String
    Dim nMnth As String
    cMnth = Format(Date, "mmmm")
    nMnth = Format(DateAdd("m", 1, Date), "mmmm")
    Dim cYear As String
    cYear = CStr(Year(Date))
    Dim cPath As String
    Dim nPath As String
    'change the next two lines to reflect your path.
    cPath = "C:\Documents and Settings\Alan M Sidman\Desktop" & "\" & cYear & "\" & cMnth & "\"
    nPath = "C:\Documents and Settings\Alan M Sidman\Desktop" & "\" & cYear & "\" & nMnth & "\"
    Dim cFile As String
    Dim nFile As String
            
    Application.ScreenUpdating = False
'OPEN Excel Files
    cFile = Dir(cPath & "*.xls*")
    Do While Len(cFile) > 0
        Set cTarg = Workbooks.Open(cPath & cFile)
        Set ws2 = cTarg.Sheets("Sheet1") 'Change this if you are using a different sheet name.
        lr = ws.Range("A" & Rows.Count).End(xlUp).Row
                Dest.Sheets("Data").Range("A" & lr + 1).Value = ws2.Range("C5").Value
                ws.Range("B" & lr + 1).Value = cTarg.Name
                ws.Range("C" & lr + 1).Value = ws2.Range("C110").Value
                ws.Range("D" & lr + 1).Value = ws2.Range("F16").Value
                ws.Range("E" & lr + 1).Value = ws2.Range("F10").Value
                ws.Range("F" & lr + 1).Value = ws2.Range("F7").Value
                ws.Range("G" & lr + 1).Value = ws2.Range("F8").Value
           

        cTarg.Close False
        cFile = Dir
    Loop
    
    nFile = Dir(nPath & "*.xls*")
    Do While Len(nFile) > 0
        Set nTarg = Workbooks.Open(nPath & nFile)
        Set ws2 = nTarg.Sheets("Sheet1") 'Change this if you are using a different sheet name.
        lr = ws.Range("A" & Rows.Count).End(xlUp).Row
                Dest.Sheets("Data").Range("A" & lr + 1) = ws2.Range("C5")
                ws.Range("B" & lr + 1) = nTarg.Name
                ws.Range("C" & lr + 1) = ws2.Range("C110")
                ws.Range("D" & lr + 1) = ws2.Range("F16")
                ws.Range("E" & lr + 1) = ws2.Range("F10")
                ws.Range("F" & lr + 1) = ws2.Range("F7")
                ws.Range("G" & lr + 1) = ws2.Range("F8")
            

                
        nTarg.Close False
        nFile = Dir
    Loop
     
    Application.ScreenUpdating = True
    
End Sub

How to install your new code

1. Copy the Excel VBA code
2. Select the workbook in which you want to store the Excel VBA code
3. Press Alt+F11 to open the Visual Basic Editor
4. Choose Insert > Module
5. Edit > Paste the macro into the module that appeared
6. Close the VBEditor
7. Save your workbook (Excel 2007+ select a macro-enabled file format, like *.xlsm)

To run the Excel VBA code:

1. Press Alt-F8 to open the macro list
2. Select a macro in the list
3. Click the Run button

Thanks to both of you. This is great. I have a problem linking to the file though. Could you please have a check at my revised code?

I get a "Run-time error '5': Invalid procedure call or argument" error :/

Sub Calendar()
'Declare and set Variables
    Dim cTarg As Workbook
    Dim nTarg As Workbook
    Dim Dest As Workbook
    Set Dest = ThisWorkbook
    Dim ws As Worksheet, ws2 As Worksheet
    Set ws = Dest.Sheets("Data")
    Dim lr As Long
    Dim cMnth As String
    Dim nMnth As String
    cMnth = Format(Date, "mmmm")
    nMnth = Format(DateAdd("m", 1, Date), "mmmm")
    Dim cYear As String
    cYear = CStr(Year(Date))
    Dim cPath As String
    Dim nPath As String
    'change the next two lines to reflect your path.
    cPath = ActiveWorkbook.Path & "\" & cYear & "\" & cMnth & "\"
    nPath = ActiveWorkbook.Path & "\" & cYear & "\" & nMnth & "\"
    Dim cFile As String
    Dim nFile As String
            
    Application.ScreenUpdating = False
'OPEN Excel Files
    cFile = Dir(cPath & "*.xls*")
    lr = 2
    Do While Len(cFile) > 0
        Set cTarg = Workbooks.Open(cPath & cFile)
        Set ws2 = cTarg.Sheets(1) 'Change this if you are using a different sheet name.
                Dest.Sheets("Data").Range("A" & lr).Formula = ws2.Range("C5").Value
                ws.Hyperlinks.Add ws.Range("B" & lr), "", cPath & cFile, "", ws2.Range("C7").Value
                'ws.Range("B" & lr).Value = cTarg.Name
                ws.Range("C" & lr).Value = ws2.Range("C110").Value
                ws.Range("D" & lr).Value = ws2.Range("F16").Value
                ws.Range("E" & lr).Value = ws2.Range("F10").Value
                ws.Range("F" & lr).Value = ws2.Range("F7").Value
                ws.Range("G" & lr).Value = ws2.Range("F8").Value
                ws.Range("H" & lr).Value = ws2.Range("F14").Value
           
        lr = lr + 1
        cTarg.Close False
        cFile = Dir
    Loop
    
    nFile = Dir(nPath & "*.xls*")
    Do While Len(nFile) > 0
        Set nTarg = Workbooks.Open(nPath & nFile)
        Set ws2 = nTarg.Sheets(1) 'Change this if you are using a different sheet name.
                Dest.Sheets("Data").Range("A" & lr).Formula = ws2.Range("C5").Value
                ws.Range("B" & lr + 1).Value = nTarg.Name
                ws.Range("C" & lr + 1).Value = ws2.Range("C110")
                ws.Range("D" & lr + 1).Value = ws2.Range("F16")
                ws.Range("E" & lr + 1).Value = ws2.Range("F10")
                ws.Range("F" & lr + 1).Value = ws2.Range("F7")
                ws.Range("G" & lr + 1).Value = ws2.Range("F8")
                ws.Range("H" & lr + 1).Value = ws2.Range("F14").Value
            

        lr = lr + 1
        nTarg.Close False
        nFile = Dir
    Loop
     
    Application.ScreenUpdating = True
    
End Sub

When you click on debug, which line is highlighted? You used ActiveWorkbook.Path and then the variables. Are the Source files (2014/ParticularMonth) in a sub folder of the destination file? If you were to write out the full path for the source files, how does it compare to the path for the destination file? I tested using a specific file path.

BTW: it is not necessary when responding to quote the entire previous post. If there are particular lines that are relevant, then quote those. Otherwise it is only taking ups space.

Alan

like that:

ws.Hyperlinks.Add ws.Range("B" & lr), cPath & cFile, TextToDisplay:= ws2.Range("C7").Value

You may try:

        ws.Hyperlinks.Add Anchor:=ws.Range("B" & lr), Address:=cPath & cFile, TextToDisplay:=CStr(ws2.Range("C7").Value)