Contar archivos por tipo en carpeta/subcarpetas

[highlander38]

Buenos dias a todos.

Con este codigo:

Option Explicit

Const PATH As String = "C:\Documents and Settings\LAMOGA\Escritorio\Formulario Web\"


Public Sub Form_Load()

    Call CountFileType("xlsm")

End Sub


Public Sub CountFileType(ByVal fType As String)

Dim c As Long


If LenB(Dir(PATH & "\*." & fType)) <> 0 Then

    c = c + 1

    Do While (LenB(Dir()) <> 0)

        c = c + 1                     ' found another file increment counter

    Loop

    MsgBox "Number of " & fType & " = " & c

Else

    MsgBox "Cant find any " & fType & " files!"

End If


End Sub

[/CODE]

me cuenta los archivos tipo xlsm en una carpeta determinada.

Mi cuestion es que quiero buscar tambien en subcarpetas, ya que estas me cambian de nombre constantemente.

A ser posible, aunque no es indispensable, que el resultado total de archivos lo guarde en alguna celda del excel, para poder compararlo posteriormente con otra celda.

Gracias de antemano.

[highlander38]

Ya podeis cerrar el tema

[blas123blas]

hola, encontre este codigo en otro portal ( https://exceltotal.com/macro-para-listar-archivos-de-carpetas-y-subcarpetas/  ).

Desde un boton en la hoja de calculos llamas a un inputbox donde colocas la carpeta que necesitas.

Como apreciaras en el codigo , la rutina recorre el directorio principal y luego sus subdirectorios.

Quizas te sea de utilidad para agregar en el tuyo

 

Private Sub BOTON_CARPETA_Click()

ruta = InputBox("INGRESE LA RUTA DONDE BUSCAR LOS ARCHIVOS")
Range("B6") = ruta
Range("I5").Select
Mostrar_Archivos (ruta)

End Sub

Sub Mostrar_Archivos(ruta)
 
    'Sección 1: Declaración de variables y objetos
    Dim fs, carpeta, archivo, subcarpeta As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
     
    'Sección 2: Ajustes necesarios a ruta
    If ruta = "" Then
        Exit Sub
    ElseIf Right(ruta, 1) <> "" Then
        ruta = ruta & "\"
    End If
     
    'Sección 3: Objeto Folder de la ruta indicada
    On Error GoTo ErrHandler
    Set carpeta = fs.GetFolder(ruta)
     
    'Sección 4: Obtener archivos del objeto Folder
    For Each archivo In carpeta.Files
        ActiveCell.Value = ruta & archivo.Name
        ActiveCell.Offset(1, 0).Select
    Next
     
    'Sección 5: Obtener subcarpetas del objeto Folder
    For Each subcarpeta In carpeta.SubFolders
        Mostrar_Archivos (subcarpeta)
    Next
     
    'Sección 6: Auto-ajustar columnas y salir
    ActiveCell.EntireColumn.AutoFit
    Exit Sub
     
ErrHandler:
    ActiveCell.Value = "Ruta inexistente"
 
End Sub