VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "MyFileSearch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'---------------------------------------------------------------------------------
' Autore  : Ivan Venuti
'           http://ivenuti.altervista.org
'---------------------------------------------------------------------------------
'
' Licenza : Potete usare/distribuire liberamente questo software in qualsiasi
'           programma (commerciale e non) purché rimanga traccia che sono
'           l'autore originale (credits) e un riferimento al mio sito
'           (http://ivenuti.altervista.org) nei sorgenti.
'           Se i sorgenti non sono distribuiti (o vengono resi non editabili
'           mediante una password) allora mantenere un riferimento nella
'           documentazione del progetto.
'
' Questa classe è fornita così com'è, senza garanzia alcuna di funzionamento.
' Usatela a vostro rischio e pericolo: nessun danno da essa causata mi può essere
' imputato.
'
'---------------------------------------------------------------------------------
' Anche se non siete obbligati a farlo, se migliorate questa classe mi
' piacerebbe ricevere le vostre modifiche. Grazie.
'---------------------------------------------------------------------------------
' Anziché usare:
'
' With Application.FileSearch
'        .NewSearch
'        .LookIn = cartella
'        .FileType = msoFileTypeWordDocuments
'        .SearchSubFolders = sottocartelle
'        .Execute
' End With
'
' Usare:
'
' Dim mFileSearch As New myFileSearch
' With mFileSearch
'   ...
' End With



' Costanti che identificano le estensioni dei file
' associate a ciascuna applicazione di Office

Private Const ALL_EXT As String = ""
Private Const WORD_EXT As String = ".doc.rtf.docx.docm"
Private Const EXCEL_EXT As String = ".xls.xla.xlsm.xlsx"
Private Const PPT_EXT As String = ".xls.xla.xlsm.xlsx"
Private Const ACCESS_EXT As String = ".xls.xla.xlsm.xlsx"
Private Const IMAGE_EXT As String = ".gif.jpg.bmp.tiff.jpeg.png"


' Variabili private (non accessibili direttamente)
'
Private prop_SearchSubFolders As Boolean    ' se True scorre anche le sottocartelle
Private prop_LookIn As String               ' Cartella da dove iniziare la ricerca
Private prop_FileTypeExtension As String    ' estensioni dei file da ricercare
                                            ' (se = ALL_EXT significa TUTTE)
Private prop_FoundFiles As New Collection


' FoundFiles: solo in lettura; per questo non c'è il Let
Property Get FoundFiles() As Collection
    Set FoundFiles = prop_FoundFiles
End Property


' LookIn: E' possibile solo settare il valore non leggerlo; per questo non c'è il Get
Property Let LookIn(ByVal val As String)
    prop_LookIn = val
End Property


' SearchSubFolders: E' possibile solo settare il valore non leggerlo; per questo non c'è il Get
Property Let SearchSubFolders(ByVal val As Boolean)
    prop_SearchSubFolders = val
End Property

' FileType: E' possibile solo settare il valore non leggerlo; per questo non c'è il Get
Property Let FileType(ByVal val As MsoFileType)
    Select Case val
        Case Is = MsoFileType.msoFileTypeAllFiles:
            prop_FileTypeExtension = ""
        Case Is = MsoFileType.msoFileTypeOfficeFiles:
            prop_FileTypeExtension = WORD_EXT & EXCEL_EXT & PPT_EXT & ACCESS_EXT
        Case Is = MsoFileType.msoFileTypeDatabases:
            prop_FileTypeExtension = ACCESS_EXT
        Case Is = MsoFileType.msoFileTypeExcelWorkbooks:
            prop_FileTypeExtension = EXCEL_EXT
        Case Is = MsoFileType.msoFileTypePowerPointPresentations:
            prop_FileTypeExtension = PPT_EXT
        Case Is = MsoFileType.msoFileTypeWordDocuments:
            prop_FileTypeExtension = WORD_EXT
        Case Is = MsoFileType.msoFileTypePhotoDrawFiles
            prop_FileTypeExtension = IMAGE_EXT
        Case Else:
            Err.Raise 5    ' 5 == Invalid procedure argument
    End Select
End Property

' Costruttore della classe
Private Sub Class_Initialize()
    ' Richiama NewSearch, come se fosse una nuova ricerca
End Sub

' Riporta i valori di default nelle diverse le proprietà
' e "svuota" il vecchio risultato
Public Sub NewSearch()
    prop_SearchSubFolders = False
    prop_FileTypeExtension = ALL_EXT
    ' results
    Set prop_FoundFiles = New Collection
End Sub

' Effettua la ricerca
Public Sub Execute()
    prendiFile prop_FileTypeExtension, prop_LookIn, prop_SearchSubFolders
End Sub

'
Private Sub prendiFile(filtro As String, cartella As String, sottocartelle As Boolean)
    ' Debug.Print "prendiFile, filtro=" & filtro & "; cartella=" & cartella & "sottocartelle = " & sottocartelle & " indice=" & indice
    Dim fsObj As Object ' Scripting.FileSystemObject
    Set fsObj = CreateObject("Scripting.FileSystemObject") 'New Scripting.FileSystemObject
    Dim i As Integer
    Dim objFolder As Object ' Scripting.Folder
    Set objFolder = fsObj.GetFolder(cartella)
    Debug.Print objFolder.Name & " -> " & objFolder.fileS.Count
    Dim objFile As Object ' Scripting.File
    For Each objFile In objFolder.fileS
        If (VBA.InStr(1, filtro, estensione(objFile.Name), vbTextCompare) > 0) Then
            Debug.Print objFile.Path & " aggiunto tra i file..."
            If prop_FoundFiles Is Nothing Then
                Set prop_FoundFiles = New Collection
            End If
            prop_FoundFiles.Add objFile.Path
        Else
            ' Debug.Print objFile.Name & " non è un file che rispetta il filtro..."
        End If
    Next objFile
   
    If (sottocartelle) Then
        Dim objSubdirs As Object 'Scripting.Folders
        Dim objLoopFolder As Object 'Scripting.Folder
        Set objSubdirs = objFolder.SubFolders
        For Each objLoopFolder In objSubdirs
            prendiFile filtro, objLoopFolder.Path, sottocartelle
        Next objLoopFolder
        Set objSubdirs = Nothing
        Set objFolder = Nothing
    End If
End Sub

' Prende l'estensione del nome del file passato come argomento
Private Function estensione(nomeFile As String) As String
    Dim punto As Long
    punto = VBA.InStrRev(nomeFile, ".", , vbBinaryCompare)
    If (punto > 0) Then
        estensione = VBA.Mid$(nomeFile, punto)
    Else
        estensione = "no extension"
    End If
End Function