Search for a string on all excel files inside a ZIp folder

[Moreno20]

Hello,

I have made a macro that allows me to search for a certain string on all excel files in a specific folder.

My problem is that, that specific folder also contains ZIP files, and inside those ZIP files, are more Excel files.

How can I include the "*.zip\*.xlsx" in my search range?

The start of the code is the following:
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Dim MyFolder As String
Dim MyFile As String
Dim ws As Worksheet
MyFolder = "C:\Users\Username\Desktop\New Folder"
MyFile = Dir(MyFolder & "\*.xlsx")

[snb]

Can you tell more about what you want to achieve & why ?

[Moreno20]

I want to use this macro at work.

We sometimes need to look for a certain and unique Code inside multiple excel files that are inside a specific folder., and once the code is found, to copy certain information on that row to another sheet.

I have the whole code done already, the only problem is that the search doesn't include the excel files that are inside a zip folder.

Here goes the whole code

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Dim MyFolder As String
Dim MyFile As String
Dim ws As Worksheet
MyFolder = "C:\Users\Username\Desktop\New Folder"
MyFile = Dir(MyFolder & "\*.xlsx")

ultimalinha = 1000 'Lastrow
Code= UCase(TextBox1.Value)

Do While MyFile <> ""
        Workbooks.Open Filename:=MyFolder & "\" & MyFile
        For Each ws In ActiveWorkbook.Worksheets
        
            'Set-up BY
            For linha = 1 To ultimalinha
                If Worksheets(1).Range("A" & linha).Value = Code Then
                    Worksheets(1).Range("B" & linha).Cells.Copy
                        Workbooks("Final-Search.xlsm").Sheets(1).Range("A1").PasteSpecial
                    Worksheets(1).Range("D" & linha).Cells.Copy
                        Workbooks("Final-Search.xlsm").Sheets(1).Range("B1").PasteSpecial
                End If
            Next
            
            'Controlled BY
            For linha = 1 To ultimalinha
                If Worksheets(2).Range("A" & linha).Value = Code Then
                    Worksheets(2).Range("B" & linha).Cells.Copy
                        Workbooks("Final-Search.xlsm").Sheets(1).Range("A2").PasteSpecial
                    Worksheets(2).Range("D" & linha).Cells.Copy
                        Workbooks("Final-Search.xlsm").Sheets(1).Range("B2").PasteSpecial
                End If
            Next
        
        
        Next ws
         
        'Close Excel Files
        Application.DisplayAlerts = False
        ActiveWorkbook.Close savechanges:=False
        Application.DisplayAlerts = True
        MyFile = Dir


    Loop

End sub

[Kenneth Hobs]

Please use code tags for code. IN the Go Advanced reply, click the # icon to add the tags.

Unzip the files. http://www.rondebruin.nl/win/section7.htm

[Moreno20]

Thank you for the link, I've checked it before.

But I would like to make this search with having to extract the files from the ZIP folder.Just open the zip, go through all Excel files inside, and close the ZIP again.

[westconn1]

while it is easily possible to loop through files within a zip file, each excel file would have to be unzipped to open, so probably just as easy to unzip all files first

while it appears you can open zipped xl files, from within zip programs, they all unzip to temporary location first

[Blade Hunter]

Moreno20, I cleaned your initial code up a bit for you. Removed the selecting as it's not the most efficient way to do things.

Also, if you are guaranteed data in column A to the bottom then take not of my code comments on your loop. This will cut out unnecessary looping and remove a variable.

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Dim MyFolder As String
Dim MyFile As String
Dim ws As Worksheet
MyFolder = "C:\Users\Username\Desktop\New Folder"
MyFile = Dir(MyFolder & "\*.xlsx")
ultimalinha = 1000 'Lastrow
Code = UCase(TextBox1.Value)
Do While MyFile <> ""
    Workbooks.Open Filename:=MyFolder & "\" & MyFile
    For Each ws In ActiveWorkbook.Worksheets
         'Set-up BY
        For linha = 1 To ultimalinha 'You can probably replace this variable with range("A" & Rows.count).end(xlup).row
            If Worksheets(1).Range("A" & linha).Value = Code Then
                Workbooks("Final-Search.xlsm").Sheets(1).Range("A1").Formula = Worksheets(1).Range("B" & linha).Text
                Workbooks("Final-Search.xlsm").Sheets(1).Range("B1").Formula = Worksheets(1).Range("D" & linha).Text
            End If
        Next
         'Controlled BY
        For linha = 1 To ultimalinha 'You can probably replace this variable with range("A" & Rows.count).end(xlup).row
            If Worksheets(2).Range("A" & linha).Value = Code Then
                Workbooks("Final-Search.xlsm").Sheets(1).Range("A2").Formula = Worksheets(2).Range("B" & linha).Text
                Workbooks("Final-Search.xlsm").Sheets(1).Range("B2").Formula = Worksheets(2).Range("D" & linha).Text
            End If
        Next
    Next ws
    Application.DisplayAlerts = False
    ActiveWorkbook.Close savechanges:=False
    Application.DisplayAlerts = True
    MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub

Hope it helps you out.

Dan