macro to folders and subfolders

Google: excel vba loop through all files folder subfolders

You'll get lots of examples.

I'm not sure what you are asking for ... I don't understand the Italian so I can't adjust your code.

The Google search I suggested will help you to loop through all the files in folders and their sub-folders. What you do in terms of processing the files is entirely up to you but, realistically, it's what you are currently doing for each of the files in the top level folder.

Ciao max_max,

Come va? Si prega di spiegare in italiano "Editing for research".

Hello max_max,

By "research" did you mean to search recuirsively?
La parola "research" si intende una ricerca in modo ricorsivo?

Hello Max,

I have added a new VBA module to original code. This module searches subfolders recursively to any depth.

Here is the code that has been added to the attached workbook.

Module1 Code
Copy to clipboard
'Option Explicit

Public ApplicationFileSearch As New FileSearch


'=================================================
'non cambiare il nome a questo file
'=================================================


Sub apri_e_verifica()
Dim obiettivo
Dim A As Range
Dim trova As FileSearch
Dim cartella As Integer
Dim x As Long
Dim cl As Range
Dim nome_file As String
Dim FoundFiles() As Variant

Dim Comm1, Comm2, Comm3 As String

Dim vuoto As Boolean
Set trova = ApplicationFileSearch
vuoto = False


'IMPOSTO LA VARIABILE "x" COME INDICE DI RICERCA DELL'ULTIMA RIGA
'OCCUPATA DELLA COLONNA A DEL FILE "search_file"

x = Workbooks("search_file.xls").Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1

'CANCELLO IL RANGE DOVE VERRANNO INSERITI I DATI

Workbooks("search_file.xls").Sheets(1).Range("A4:C" & x).ClearContents

obiettivo = InputBox("Inserisci il codice da cercare", "Ricerca codice")
Application.ScreenUpdating = False

'SE L'INPUTBOX è VUOTA, AVVISA ED ESCE DALLA ROUTINE

If obiettivo = "" Then
vuoto = True
MsgBox "devi inserire un codice", vbExclamation, "ATTENZIONE"
End If
If Not vuoto Then

'With trova

'INDICO IL PERCORSO DELLA CARTELLA DOVE SONO I FILE DA APRIRE

Comm1 = ActiveSheet.Range("B1").Value '<<< nome cella 1
Comm2 = ActiveSheet.Range("B2").Value '<<< nome cella 2
Comm3 = Comm1 & "-" & Comm2 '<<< unite

' Search All SubFolders in the Parent folder's SubFolders and their SubFolders, etc.
Call GetSubFolders("C:\Users\massimo\Desktop\MAX\moduli_salvati\" & Comm3 & "\", FoundFiles, -1)

'.LookIn = "C:\Users\massimo\Desktop\MAX\moduli_salvati\"

'INDICO IL TIPO DI FILE DA APRIRE

'.filename = "*.xls"

'METODO EXECUTE RESTITUISCE IL NUMERO DEI FILES DELLA
'DIRECTORY SPECIFICATA; SE è = 0 AVVISA ED ESCE DALLA ROUTINE

If UBound(FoundFiles) >= 0 Then

'CICLO FOR CHE APRE TUTTI I FILE CONTENUTI NELLA CARTELLA "moduli_salvati"
'CON LA PROPRIETà "FoundFiles"
'DALL'HELP ON LINE :
'Restituisce un oggetto FoundFiles contenente i nomi di tutti i
'file trovati durante la ricerca. Di sola lettura.
' E CON LA PROPRIETà "Count" CHE RESTITUISCE IL NUMERO
'DELL'ULTIMO FILE

For cartella = 0 To UBound(FoundFiles) - 1
Workbooks.Open FoundFiles(cartella)
nome_file = ActiveWorkbook.Name
Set A = Workbooks(nome_file).Sheets(1).Range("L7:L31")

'CICLO PER VERIFICARE L'ESISTENZA DEL CODICE NEI FILES; SE LO TROVA,
'INSERISCE IL CODICE, IL NOME DEL FILE E L'INDIRIZZO DELLA CELLA
'NEL FILE "search_file", ED ESSENDO UN CODICE UNIVOCO, ESCE DAL CICLO E
'PASSA AL FILE SUCCESSIVO

For Each cl In A
If cl = obiettivo Then
With Workbooks("search_file.xls").Sheets(1)

'RE-IMPOSTO LA VARIABILE "x" COME INDICE DI RICERCA DELL'ULTIMA RIGA
'OCCUPATA DELLA COLONNA A DEL FILE "search_file"

x = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Range("A" & x) = cl
.Range("B" & x) = Workbooks(nome_file).Name
.Range("C" & x) = cl.Address(False, False)
End With
Exit For
End If
Next cl

'CHIUDO LA CARTELLA ATTIVA

Workbooks(nome_file).Close

'PROSSIMO FILE DA APRIRE

Next cartella

Else
MsgBox "Nella directory scelta non ci sono Files"
End If
End With

If Workbooks("search_file.xls").Sheets(1).Range("A4") = "" Then
MsgBox "Non è stato trovato nessun codice " & obiettivo, vbExclamation, _
"VERIFICA CONCLUSA"
Else
MsgBox "Il codice " & obiettivo & " è stato trovato in " & x - 3 & " file/s", _
vbInformation, "VERIFICA CONCLUSA"
End If
End If
Application.ScreenUpdating = True
Set A = Nothing
Set trova = Nothing
End Sub
Module2 Code
Copy to clipboard
Global oShell As Object

Sub GetSubFolders(ByVal Folder As Variant, ByRef FilePathList As Variant, Optional ByVal SubFolderDepth As Long)

Dim n As Variant
Dim oFiles As Object
Dim oFolder As Object
Dim SubFolder As Variant
Dim SubFolders As Object

If VarType(FilePathList) = vbArray + vbVariant Then
On Error Resume Next
If Err <> 0 Then ReDim Preserve FilePathList(0)
On Error GoTo 0
End If

If oShell Is Nothing Then
Set oShell = CreateObject("Shell.Application")
End If

Set oFolder = oShell.Namespace(Folder)

If oFolder Is Nothing Then Exit Sub

Set oFiles = oFolder.Items
oFiles.Filter 64, "*.xls"

For n = 0 To oFiles.Count - 1
x = oFiles.Item(n).Path
FilePathList(UBound(FilePathList)) = oFiles.Item(n).Path
ReDim Preserve FilePathList(UBound(FilePathList) + 1)
Next n

Set SubFolders = oFolder.Items
SubFolders.Filter 32, "*"

For Each SubFolder In SubFolders

Okay, over the years I have seen some strange things happen on this forum. But my last post takes it. I can not even edit the system errors in the post at this time.

@ Leith

Just wanted to report your post for using code tags.

Hello max_max,

Since I cannot change my post #12, I will try to repost the module code again.

Module1 Code

Please Login or Register  to view this content.

Module2 Code

Please Login or Register  to view this content.

Hello Max,

The workbook has been tested and works correctly as is. Please do not add any additional code or change any code in this workbook.

Let me if have any issues so I can address them accordingly.

You can download it from here...

Search_File ver 1.xls

Hello Max,

I have run the macro several times. Each time the number of rows of file information on the worksheet matches the number of files in the message box "VERIFICA CONCLUSA".

Something is different, Can you post a few examples of this problem?

Hello Max,

I have had a lot of difficulty the past few days in posting and answering private messages. The problem is most likely one of the servers in the chain to the Excel Forum.

Both macros needed to be updated to handle the new column "B" for the folder path.

Here is the updated code. I will try to post the workbook also.

Module1 Code

Please Login or Register  to view this content.

Module2 Code

Please Login or Register  to view this content.

Hello leith ross.
I updated the modules as written in the previous post, but it does not work, if I done correctly.
I attaching photos of the error and the modified file, also I attach for searching.

VBA > F8 error here:

Workbooks.Open FoundFiles(cartella, 1) & "\" & FoundFiles(cartella, 2) '<<<
If Err.Number = 9 Then '<<<
MsgBox "The path """ & Path & """ is missing or the name has been changed.", vbCritical, "Path Error" '<<<
Exit Sub '<<<

max_max