'********** Código *************
'
' Función mostrarCarpetas:

' Función que busca recursivamente en la carpeta
' que se le ha pasado en el argumento "Ruta",
' e imprime en la ventana inmediato los valores
' encontrados.
' La función Dir de VB no puede usarse en proce-
' dimientos recursivos y por tanto he usado el
' API, con las funciones FindFirstFile, FindNextFile
' y FindClose. Igualmente, en la estructura
' WIN32_FIND_DATA, puede usarse para devolver infor-
' mación sobre los archivos o carpetas encontrados.
'
' Autor: Juan M. Afán de Ribera - happy
' Fecha: Mayo 2003
'
' ¿Por qué?: Alguien lo preguntó
'
Private Declare Function FindFirstFile Lib "kernel32" _
            Alias "FindFirstFileA" _
            (ByVal lpFileName As String, _
            lpFindFileData As WIN32_FIND_DATA) As Long
            
Private Declare Function FindNextFile Lib "kernel32" _
            Alias "FindNextFileA" _
            (ByVal hFindFile As Long, _
            lpFindFileData As WIN32_FIND_DATA) As Long
            
Private Declare Function FindClose Lib "kernel32" _
            (ByVal hFindFile As Long) As Long


Private Const MAX_PATH = 255

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

Function mostrarCarpetas(Ruta As String)
Dim WFD As WIN32_FIND_DATA
Dim hBusca As Long
Dim ret As Long
Dim nomCarpeta As String

    If Right(Ruta, 1) <> "\" Then Ruta = Ruta & "\"
    
    hBusca = FindFirstFile(Ruta & "*", WFD)
    
    If hBusca <> -1 Then
    
        ret = True
    
        While ret
            nomCarpeta = ExtraerNulos(WFD.cFileName)
            If (nomCarpeta <> ".") And (nomCarpeta _ 
                                    <> "..") Then
                If (GetAttr(Ruta & nomCarpeta) And _
                      vbDirectory) = vbDirectory Then
                    If (GetAttr(Ruta & nomCarpeta) And _
                      vbDirectory) = vbDirectory Then
                        mostrarCarpetas Ruta & _ 
                                        nomCarpeta & "\"
                        Debug.Print Ruta & nomCarpeta
                        'SysCmd acSysCmdSetStatus, _ 
                         Ruta &  nomCarpeta
                    End If
                End If
            End If
            ret = FindNextFile(hBusca, WFD)
        Wend
    
        FindClose hBusca
    
        'SysCmd acSysCmdClearStatus
        End If
        
End Function

Function ExtraerNulos(cad As String) As String
    If (InStr(cad, Chr(0)) > 0) Then
        cad = Left(cad, InStr(cad, Chr(0)) - 1)
    End If
    ExtraerNulos = cad
End Function
'************** Fin código *************