0

I am trying to design a tool for general use, that can open all the ".xlsx" files in only some subfolders (all of them share a common word, in this case is "Depto") in a massive folder <"H:/">. I have tried with two soutions I have ound on internet but non of them work as they should. the first one is this:

Open all the files in subfolders

it only open 1 file when I add the macro I need them to do for each of the files (copy the information in another excel file)

then the second solution I have is this one, which I have been trying to make work: altho my for each is not working properly:

Option Explicit

'Late binding version

Public Sub Open_All_Workbooks_In_Folders()
       
    Dim FldrPicker As FileDialog

    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
        
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        
        If .Show Then
            
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            
            Open_Workbooks_In_Folder .SelectedItems(1), "*.xlsx"
            
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            
            MsgBox "Done"
        
        End If
        
    End With
       
End Sub

Private Sub Open_Workbooks_In_Folder(folderPath As String, matchWorkbooks As String)

    Static FSO As Object
    Dim thisFolder As Object, subfolder As Object
    Dim thisFile As Object
    Dim wb As Workbook
    Dim SubFolderName As String
    Dim i As Integer
    i = 0
    
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Set thisFolder = FSO.GetFolder(folderPath)
    
    SubFolderName = thisFolder.Name
If InStr(1, SubFolderName, "Dept") <> 0 Then
    
    For Each thisFile In thisFolder.Files
    i = i + 1
        If LCase(thisFile.Name) Like LCase(matchWorkbooks) Then
        
            Set wb = Workbooks.Open(thisFile.Path, UpdateLinks:=3)
            
            Windows("Massive Compilation Tools.xlsm").Activate
            Range("A" & i).Select
            Range("A" & i).Value = thisFile.Path
            wb.Activate
            wb.Close SaveChanges:=False 'True

            DoEvents
        End If
    Next
End If
    'Do subfolders
    
    For Each subfolder In thisFolder.SubFolders
        Open_Workbooks_In_Folder subfolder.Path, matchWorkbooks
    Next
    
End Sub

What I am trying to do is to create a compilation tool for 124 files distributed in different subfolders. The result so far is 1 of my macros is opening the files but it doesn't copy and paste the information in the order I need (it only overwrite the same place)

  • `i` variable is set to 0 for every subfolder as you recursively call `Open_Workbooks_In_Folder`. You need to pass `i` either as byref parameter to `Open_Workbooks_In_Folder` (this is recommended) or you need to define `i` as a global variable outside of all subs and functions (easier, but is not in line with good programming practices). – Shadow Dec 12 '22 at 09:51

0 Answers0