Saltar al contenido

Contar archivos por tipo en carpeta/subcarpetas

publicado

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.

Featured Replies

  • 6 years later...
publicado

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

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.