aca va otra forma, igual a la que usa Dir$ que puse antes, pero esta es recursiva y usa apis, lo cual es muchisimo mas rapida.
la anterior funcion me tarda 7 segundos en escanear la carpeta de program files de mi pc (que tiene 7 mil carpetas), esta solo tarda 1 segundo y a veces menos
.
saludos.
la anterior funcion me tarda 7 segundos en escanear la carpeta de program files de mi pc (que tiene 7 mil carpetas), esta solo tarda 1 segundo y a veces menos

Código (vb) [Seleccionar]
Option Explicit
Private Const vbDot = 46
Private Const MAXDWORD As Long = &HFFFFFFFF
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
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
Private Type FILE_PARAMS
bRecurse As Boolean
sFileRoot As String
sFileNameExt As String
sResult As String
sMatches As String
Count As Long
End Type
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
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
Dim vCarpetas As New Collection
Private Sub Command1_Click()
Call CarpetaMasProfunda("c:\program files (x86)")
Dim vResult As String
vResult = ""
Dim vArr() As String
Dim vCont As Integer
Dim i As Integer
For i = 1 To vCarpetas.Count
vArr = Split(vCarpetas(i), "\")
If UBound(vArr) > vCont Then
vCont = UBound(vArr)
vResult = vCarpetas(i)
End If
Next i
MsgBox vResult
End Sub
Private Sub CarpetaMasProfunda(ByVal pPath As String)
Dim FP As FILE_PARAMS
With FP
.sFileRoot = pPath
.sFileNameExt = "*.*"
.bRecurse = 1
End With
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
Dim sRoot As String
Dim spath As String
Dim sTmp As String
sRoot = QualifyPath(FP.sFileRoot)
spath = sRoot & FP.sFileNameExt
hFile = FindFirstFile(spath, WFD)
If hFile <> INVALID_HANDLE_VALUE Then
Do
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) And Asc(WFD.cFileName) <> vbDot Then
sTmp = TrimNull(WFD.cFileName)
FP.Count = FP.Count + 1
vCarpetas.Add sRoot & sTmp
If FP.bRecurse Then
FP.sFileRoot = sRoot & sTmp
Call CarpetaMasProfunda(FP.sFileRoot)
End If
End If
Loop While FindNextFile(hFile, WFD)
hFile = FindClose(hFile)
End If
End Sub
Private Function TrimNull(pStart As String) As String
Dim vPos As Integer
vPos = InStr(pStart, Chr$(0))
If vPos Then
TrimNull = Left$(pStart, vPos - 1)
Exit Function
End If
TrimNull = pStart
End Function
Private Function QualifyPath(pPath As String) As String
If Right$(pPath, 1) <> "\" Then
QualifyPath = pPath & "\"
Else
QualifyPath = pPath
End If
End Function
saludos.