conta foto

Option Explicit

Sub ContaFileInCartelle()
    'attn. attivare il Riferimento: Microsoft Scripting Runtime

    Dim FSO    As Object
    Dim strPath As String
    Dim strFolder As Object
    Dim cartella As Object
    Dim strFileType As String
    Dim strFile As String
    Dim contaFile  As Long
    Dim rigaAnnata As Long

    rigaAnnata = 2                                'numero riga inizio elenco
    strFileType = "*.jpg"                         'tipo immagine da contare
    Set FSO = CreateObject("Scripting.FileSystemObject")
    strPath = "F:\Prove\Immagini\"                'percorso cartella padre (da adeguare alle proprie esigenze)
    With ActiveSheet                              'nel foglio attivo
        .Range("A1") = "Annata"                   'imposta titoli colonne
        .Range("B1") = "Numero"
        Set strFolder = FSO.GetFolder(strPath).Subfolders 'rileva le sottocartelle presenti
        For Each cartella In strFolder            'ciclo sottocartelle
            strFile = Dir(cartella & "\" & strFileType) 'leggi i file immagine nella cartella
            .Range("A" & rigaAnnata) = cartella.Name 'riporta nome cartella
            Do While strFile <> ""                'ciclo all'interno della cartella
                contaFile = contaFile + 1         'somma le immagini
                strFile = Dir()
            Loop
            .Range("B" & rigaAnnata) = contaFile  'riporta conteggio immagini
            rigaAnnata = rigaAnnata + 1           'aumenta il numero di riga
            contaFile = 0                         'azzera il contatore
        Next cartella
    End With
    Set FSO = Nothing
    Set strFolder = Nothing
    
End Sub