PDA

View Full Version : Search for a string on all excel files inside a ZIp folder



Moreno20
03-04-2014, 01:51 PM
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
03-04-2014, 01:54 PM
Can you tell more about what you want to achieve & why ?

Moreno20
03-04-2014, 01:58 PM
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
03-04-2014, 03:01 PM
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
03-04-2014, 03:18 PM
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
03-05-2014, 02:06 AM
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
03-06-2014, 09:26 PM
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