I use application.filesearch a lot, but now need help with a workaround

[CameronT]

Hi Brilliant People,

I know there have been posts for workarounds, but I can't figure out how to apply to my code, because I am a complete novice when it comes to vb. Years ago, I created this code to 'mine' a bunch of excel files in a directory and extract a data table I'd hide in the background of excel workbooks. It worked perfectly and now with the powers that be killing application.filesearch, I can't seem to get a replacement working.

Private Sub CommandButton1_Click()


    'Turn off Warnings
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False


    Dim MyDir As String
    Dim strPath As String
    Dim vaFileName As Variant
    Dim i As Integer
    Dim this_workbook As String
    Dim settings_row As Integer
    Dim row_number As Integer
    Dim Current_Workbook As String
    Dim FileName As String
    Dim SaveFile As String
                        
    MyDir = ActiveWorkbook.Path ' current path
    strPath = MyDir & "/Test_Process" ' files subdir


    With Application.FileSearch
        .NewSearch
        .LookIn = strPath
        .SearchSubFolders = False
        .FileName = ".xls"


        If .Execute > 0 Then


            For Each vaFileName In .FoundFiles
            ' open the workbook
                Workbooks.Open vaFileName, Password:=""
                
                With ActiveWorkbook
                    Current_Workbook = ActiveWorkbook.Name
                
                    'Extract all Occupancy Data
                    row_number = 6
                
                    Sheets("Data_Extract").Visible = True
                    Sheets("Data_Extract").Select
                    ActiveSheet.Range("A2:M9").Select
                    Selection.Copy
        
                    Workbooks("TEST_PROCESS_REPORT.xls").Activate
                    settings_row = ActiveWorkbook.Sheets("Occupancy_Data").Range("a50000").End(xlUp).Row + 1
        
                        With ActiveWorkbook
                            .Sheets("Occupancy_Data").Select
                            ActiveSheet.Range("a" & settings_row).Select
                            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                        End With
                
                    Windows(Current_Workbook).Activate
                .Close
                
                End With
            Next
        End If
    End With


    Application.ScreenUpdating = True
End Sub

I've read there are a few workarounds, but I can't seem to get it working. Was wondering if anyone can help me?

Thanks,

Cam

 

[AlphaFrog]

Hi and welcome to the forum.

Is this code for a Mac? That's important to know. If Yes, here's a link that may help.

Loop through Files in Folder on a Mac (Dir for Mac Excel)

 

[CameronT]

Hi,

Sorry... I should have said. I'm using a Windows PC.

Cam

 

[AlphaFrog]

Try this.

[color=darkblue]Private[/color] [color=darkblue]Sub[/color] CommandButton1_Click()
    
    [color=darkblue]Dim[/color] strPath [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] strFile [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] FileCounter [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    strPath = ActiveWorkbook.Path & "\Test_Process\"    [color=green]' files subdir[/color]
    strFile = Dir(strPath & "*.xls*")                   [color=green]' First file[/color]
    
    [color=green]'Turn off Warnings[/color]
    Application.ScreenUpdating = [color=darkblue]False[/color]
    [color=darkblue]Do[/color] [color=darkblue]While[/color] strFile <> ""
    
        [color=green]' open the workbook[/color]
        [color=darkblue]With[/color] Workbooks.Open(strPath & strFile, Password:="")
            [color=green]'Copy-Paste[/color]
            .Sheets("Data_Extract").Range("A2:M9").Copy
            ThisWorkbook.Sheets("Occupancy_Data").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial _
                    Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=[color=darkblue]False[/color]
            .Close SaveChanges:=False
        [color=darkblue]End[/color] [color=darkblue]With[/color]
        
        FileCounter = FileCounter + 1
        strFile = Dir   [color=green]'Next file[/color]
        
    [color=darkblue]Loop[/color]
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
    MsgBox FileCounter & " files copied. ", , "Copy Complete"
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[CameronT]

You are a God among men. Thanks AlphaFrog - that worked perfectly!