Loop thru files in folder and copy things

[rpinxt]

I am looking for a simple piece of code that loops thru all files in a folder (so opening them and close when done).

Then after opening perform my main code.
When main code is done, close workbook and go to the next file in the folder.

[Olly]

Are all your source files in the same structure?

This is straightforward with Power Query (Get & Transform Data). Post sample workbooks.

[rpinxt]

Yes they are but why would it matter?

It just needs to cycle thru the excel files in a folder, open them, run the main code (that copies fields from the file to my main book) and then close the file again.

Need to fix it with normal VBA for Excel (no power query)

[Olly]

Why not use Power Query? It's perfect for this type of requirement. You have Excel 2016, so the functionality is built in. It's much quicker than VBA opening every file...

Something like:

    let
        FolderName = "C:\MyPath",
        SheetName = "MySheet",

        Source = Folder.Files(FolderName),
        #"Filtered XLS" = Table.SelectRows(Source, each Text.Contains([Extension], ".xls")),
        #"Selected Columns" = Table.SelectColumns(#"Filtered XLS",{"Folder Path", "Name", "Content"}),
        
        GetFileData = (FileContent) =>
            let
                Workbook = Excel.Workbook(FileContent, null, true),
                Worksheet = Workbook{[Item=SheetName,Kind="Sheet"]}[Data],
                #"Promoted Headers" = Table.PromoteHeaders(Worksheet, [PromoteAllScalars=true])
            in
                #"Promoted Headers",

        FileData = Table.TransformColumns(#"Selected Columns", {"Content", each GetFileData(_)}),
        #"Expand Content" = Table.ExpandTableColumn(FileData, "Content", List.Union(List.Transform(FileData[Content], each Table.ColumnNames(_))))
    in
        #"Expand Content"

[rpinxt]

Could be I do not know power query and not sure if I and my colleagues (who I am making this for have it).

Well is was playing around with a simple code from the net trying to amend it for my needs:

Sub LoopThroughFiles()
    Dim StrFile As String
    StrFile = Dir("P:\General\Planning Project\Data\02. Daily Week*")
    Do While Len(StrFile) > 0
        Debug.Print StrFile
        StrFile = Dir
    Loop
End Sub

The StrFile is adepted to my needs opening every thing that begins with that text up to the weeknumber.
But I do not know where to put my main code to get it to work.

[Olly]

Could be I do not know power query....

With respect, you don't know the VBA to do what you need, either...

... and not sure if I and my colleagues (who I am making this for have it).

As I said, you have Excel 2016 which has Power Query built in. Which Excel version are your colleagues using?

Happy to write the precise query you need, if you upload a sample source workbook, and indicate which data you're trying to collate.

[rpinxt]

Well I'm building vba models for year now.
No I am no expert but our company has lots of benfits from it.

This is my main code as VBA has to lookin different tabs with different length to pull out the numbers (so maybe it is not as simple as you think)

Sub ImportData()
MB = ActiveWorkbook.Name
jaar = Sheet1.Range("C5").Value
Application.ScreenUpdating = False

    'Load Data
'    Workbooks.Open Filename:="P:\General\Planning Project\Data\02. Daily Week 37.xlsm"
    Db = ActiveWorkbook.Name
    wk = Mid(Db, Len(Db) - 6, 2)

    'Copy Data
    Windows(MB).Activate
    brow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheet2.Range("A" & brow & ":A" & brow + 4).Value = jaar
    Sheet2.Range("B" & brow & ":B" & brow + 4).Value = wk
    Sheet3.Range("A1:A5").Copy
    Sheet2.Range("C" & brow).PasteSpecial xlPasteValues

        'Act Weekdays
        'Monday
        Windows(Db).Activate
        lrowA = Sheets("Monday").Range("C" & Rows.Count).End(xlUp).Row
        ActM = Sheets("Monday").Range("C" & lrowA).Copy
        Windows(MB).Activate
        actbrow = Sheet2.Range("D" & Rows.Count).End(xlUp).Row + 1
        Sheet2.Range("D" & actbrow).PasteSpecial xlPasteValues
        'Tuesday
        Windows(Db).Activate
        lrowA = Sheets("Tuesday").Range("C" & Rows.Count).End(xlUp).Row
        ActM = Sheets("Tuesday").Range("C" & lrowA).Copy
        Windows(MB).Activate
        actbrow = Sheet2.Range("D" & Rows.Count).End(xlUp).Row + 1
        Sheet2.Range("D" & actbrow).PasteSpecial xlPasteValues
        'Wednesday
        Windows(Db).Activate
        lrowA = Sheets("Wednesday").Range("C" & Rows.Count).End(xlUp).Row
        ActM = Sheets("Wednesday").Range("C" & lrowA).Copy
        Windows(MB).Activate
        actbrow = Sheet2.Range("D" & Rows.Count).End(xlUp).Row + 1
        Sheet2.Range("D" & actbrow).PasteSpecial xlPasteValues
        'Thursday
        Windows(Db).Activate
        lrowA = Sheets("Thursday").Range("C" & Rows.Count).End(xlUp).Row
        ActM = Sheets("Thursday").Range("C" & lrowA).Copy
        Windows(MB).Activate
        actbrow = Sheet2.Range("D" & Rows.Count).End(xlUp).Row + 1
        Sheet2.Range("D" & actbrow).PasteSpecial xlPasteValues
        'Friday
        Windows(Db).Activate
        lrowA = Sheets("Friday").Range("C" & Rows.Count).End(xlUp).Row
        ActM = Sheets("Friday").Range("C" & lrowA).Copy
        Windows(MB).Activate
        actbrow = Sheet2.Range("D" & Rows.Count).End(xlUp).Row + 1
        Sheet2.Range("D" & actbrow).PasteSpecial xlPasteValues

        'Plan Weekdays
        'Monday
        Windows(Db).Activate
        lrowA = Sheets("Monday").Range("C" & Rows.Count).End(xlUp).Row
        ActM = Sheets("Monday").Range("D" & lrowA).Copy
        Windows(MB).Activate
        actbrow = Sheet2.Range("E" & Rows.Count).End(xlUp).Row + 1
        Sheet2.Range("E" & actbrow).PasteSpecial xlPasteValues
        'Tuesday
        Windows(Db).Activate
        lrowA = Sheets("Tuesday").Range("C" & Rows.Count).End(xlUp).Row
        ActM = Sheets("Tuesday").Range("D" & lrowA).Copy
        Windows(MB).Activate
        actbrow = Sheet2.Range("E" & Rows.Count).End(xlUp).Row + 1
        Sheet2.Range("E" & actbrow).PasteSpecial xlPasteValues
        'Wednesday
        Windows(Db).Activate
        lrowA = Sheets("Wednesday").Range("C" & Rows.Count).End(xlUp).Row
        ActM = Sheets("Wednesday").Range("D" & lrowA).Copy
        Windows(MB).Activate
        actbrow = Sheet2.Range("E" & Rows.Count).End(xlUp).Row + 1
        Sheet2.Range("E" & actbrow).PasteSpecial xlPasteValues
        'Thursday
        Windows(Db).Activate
        lrowA = Sheets("Thursday").Range("C" & Rows.Count).End(xlUp).Row
        ActM = Sheets("Thursday").Range("D" & lrowA).Copy
        Windows(MB).Activate
        actbrow = Sheet2.Range("E" & Rows.Count).End(xlUp).Row + 1
        Sheet2.Range("E" & actbrow).PasteSpecial xlPasteValues
        'Friday
        Windows(Db).Activate
        lrowA = Sheets("Friday").Range("C" & Rows.Count).End(xlUp).Row
        ActM = Sheets("Friday").Range("D" & lrowA).Copy
        Windows(MB).Activate
        actbrow = Sheet2.Range("E" & Rows.Count).End(xlUp).Row + 1
        Sheet2.Range("E" & actbrow).PasteSpecial xlPasteValues

        'Close databook
        Application.DisplayAlerts = False
        Windows(Db).Close SaveChanges:=False
        Application.DisplayAlerts = True



Application.ScreenUpdating = True

End Sub

It is where it opens the workbook to copy from I need a loop that opens all the files in the folder one by one.
Main code should do the rest.

ps:normally I only open 1 data book, but this problem needed to have multiple books in a row openend and that why i was asking for help.

[Olly]

This combines data from all worksheets in all files (with name beginning `02. Daily Week`) in your specified folder.

let
    FolderName = "P:\General\Planning Project\Data",

    Source = Folder.Files(FolderName),
    #"Filtered Name" = Table.SelectRows(Source, each Text.StartsWith([Name], "02. Daily Week")),
        
    GetFileData = (Workbook) =>
        let
            #"Promote Headers" = Table.AddColumn(Excel.Workbook(Workbook), "Worksheet Data", each Table.PromoteHeaders([Data])),
            #"Combine Worksheets" = Table.Combine(#"Promote Headers"[#"Worksheet Data"])
        in
            #"Combine Worksheets",

    #"Get Workbook Data" = Table.AddColumn(#"Filtered Name", "Workbook Data", each GetFileData([Content])),
    #"Combine Workbooks" = Table.Combine(#"Get Workbook Data"[#"Workbook Data"])
in
    #"Combine Workbooks"

Give it a try. You might like it.

[rpinxt]

Well yes if it is better and faster I am sure I will like it.

But it is no flat data source file.
I will attach 1 weekday from 1 of the files.
Be aware all these tabs are not the same length.
And I only need 2 amounts per tab from each book.
So not sure of combining all that data (it is for 1 year so 52 books times 5 tabs...) is usefull.

[Olly]

So you want the Actual and Planned values from Columns C and D, for the last row in Column C containing data, for each worksheet in each file?

Try this:

let
    Source = Folder.Files("P:\General\Planning Project\Data"),
    #"Renamed Columns" = Table.RenameColumns(Source,{{"Name", "Filename"}}),
    fnWorkbookData = (MyWorkbook) =>
        let
            Source = Excel.Workbook(MyWorkbook, null, true),
            fnWorksheetData = (MyWorksheet) =>
                let
                    #"Select Columns" = Table.SelectColumns(MyWorksheet,{"Column3", "Column4"}),
                    #"Filtered Rows" = Table.SelectRows(#"Select Columns", each ([Column3] <> null)),
                    #"Kept Last Rows" = Table.LastN(#"Filtered Rows", 2),
                    #"Promoted Headers" = Table.PromoteHeaders(#"Kept Last Rows", [PromoteAllScalars=true]),
                    #"Changed Type" = Table.TransformColumnTypes(#"Promoted Headers",{{"Actual", Int64.Type}, {"Planned", Int64.Type}})
                in
                    #"Changed Type",
            #"Get Worksheet Data" = Table.AddColumn(Source, "WorksheetData", each fnWorksheetData([Data])),
            #"Expanded WorksheetData" = Table.ExpandTableColumn(#"Get Worksheet Data", "WorksheetData", {"Actual", "Planned"}, {"Actual", "Planned"}),
            #"Selected Columns" = Table.SelectColumns(#"Expanded WorksheetData",{"Name", "Actual", "Planned"}),
            #"Renamed Columns" = Table.RenameColumns(#"Selected Columns",{{"Name", "Sheetname"}})
        in
            #"Renamed Columns",
    #"Get Workbook Data" = Table.AddColumn(#"Renamed Columns", "WorkbookData", each fnWorkbookData([Content])),
    #"Expanded WorkbookData" = Table.ExpandTableColumn(#"Get Workbook Data", "WorkbookData", {"Sheetname", "Actual", "Planned"}, {"Sheetname", "Actual", "Planned"}),
    #"Selected Columns" = Table.SelectColumns(#"Expanded WorkbookData",{"Filename", "Sheetname", "Actual", "Planned"})
in
    #"Selected Columns"

[rpinxt]

Where would I put that code? And how do I activate it.

Further I would only want the last amounts in columns C and D for Actual and Plannend.
For the 5 weekdays in the file (nothing of the other sheets)

[Olly]

New information: workbooks contain more sheets then required. Okay. Here's an amended query to filter only worksheets Mon - Fri:

let
    fnWorksheetData = (MyWorksheet) =>
        let
            #"Select Columns" = Table.SelectColumns(MyWorksheet,{"Column3", "Column4"}),
            #"Filtered Rows" = Table.SelectRows(#"Select Columns", each ([Column3] <> null)),
            #"Kept Last Rows" = Table.LastN(#"Filtered Rows", 2),
            #"Promoted Headers" = Table.PromoteHeaders(#"Kept Last Rows", [PromoteAllScalars=true])
        in
            #"Promoted Headers",

    fnWorkbookData = (MyWorkbook) =>
        let
            wbSource = Excel.Workbook(MyWorkbook, null, true),
            #"Filtered Weekdays" = Table.SelectRows(wbSource, each List.Contains({"Mon","Tue","Wed","Thu","Fri"}, Text.Start([Name],3))),
            #"Get Worksheet Data" = Table.AddColumn(#"Filtered Weekdays", "WorksheetData", each fnWorksheetData([Data])),
            #"Expanded WorksheetData" = Table.ExpandTableColumn(#"Get Worksheet Data", "WorksheetData", {"Actual", "Planned"}, {"Actual", "Planned"}),
            #"Selected Columns" = Table.SelectColumns(#"Expanded WorksheetData",{"Name", "Actual", "Planned"}),
            #"Renamed Columns" = Table.RenameColumns(#"Selected Columns",{{"Name", "Sheetname"}})
        in
            #"Renamed Columns",

    Source = Folder.Files("P:\General\Planning Project\Data"),
    #"Renamed Columns" = Table.RenameColumns(Source,{{"Name", "Filename"}}),
    #"Get Workbook Data" = Table.AddColumn(#"Renamed Columns", "WorkbookData", each fnWorkbookData([Content])),
    #"Expanded WorkbookData" = Table.ExpandTableColumn(#"Get Workbook Data", "WorkbookData", {"Sheetname", "Actual", "Planned"}, {"Sheetname", "Actual", "Planned"}),
    #"Selected Columns" = Table.SelectColumns(#"Expanded WorkbookData",{"Filename", "Sheetname", "Actual", "Planned"})
in
    #"Selected Columns"

For how to use Power Query code, see link in my signature (https://excel.solutions/2017/11/powe...te-code-video/)

(edited to make code a little easier to read)

[dunnobe]

Hey rpinxt,

If you're still looking for a VBA solution, you might want to have a look at this:
https://www.computergaga.com/blog/lo...esystemobject/
https://exceloffthegrid.com/vba-code...r-sub-folders/

Sub LoopFolderAndFiles()
    Dim fso As Object
    Dim folder As Object
    Dim files As Object
    Dim wb As Workbook

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder("C:\Users\AJD8801\Desktop\") 'Select your main folder
    Set files = folder.files
    
    For Each files In files
            If InStr(LCase(files.Name), ".xlsx") > 0 Then
                Debug.Print files.Name
'                Set wb = Workbooks.Open(files)
                                                                    ' Write your action here for the file that you have opened
'                wb.Close SaveChanges:=False
            End If
    Next
     
    Set fso = Nothing
    Set folder = Nothing

    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With

End Sub

No offence, Olly :p
You're probably much more of an expert than I am.

Bram

[rpinxt]

Thanks Olly and Bram.
I indeed found a solution in the classic VBA code

Dim wb As Workbook, ws As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")

'Set Folder path
Set fldr = fso.GetFolder("P:\General\Planning Project\Data\")

'Loop through each file in that folder
For Each wbFile In fldr.Files

'Make sure looping only through files ending in .xlsx (Excel files)
If fso.GetExtensionName(wbFile.Name) = "xlsm" Then

'Open current book
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Set wb = Workbooks.Open(wbFile.Path)
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True

*******MAIN CODE******

Next wbFile

I will look into the power query solution, maybe I can unravel how to use it

[dunnobe]

Hey rpinxt,

Write down your entire code.
No doubt someone can give you some advice on making your code more efficient.

https://analysistabs.com/vba/optimiz...macros-faster/

Speed is everything.

Bram

[rpinxt]

I agree dunnobe.

But I am ok with the speed of my macro

And yes the real wizards can most likely make it much more fast.
But then the code that they are using I do not understand anymore .
I like to also understand what is going on. Would have to study on their code and unfortunately I do not have that time at the moment .

ps: forgot to close the thread. Sorry.