Cometi el error de copypastear tu codigo en una CMD.
CUIDADO CON EL PESO DEL TXT!
Si, hice un par de pruebas mas y vi que puede obtenerse un archivo grande, aunque habría que hacer algunas comparativas para ver si el método conviene o no...
Ni bien tenga VB a mano, armo code y copio...
EDIT: Mi intento
Option Explicit
Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Const sEmpty = ""
Const cMaxPath = 260
Const cmDbl = """"
Public Function getDeeperPath(Folder As String) As String
'Function does not check if Folder is a valid path name
'Folder must NOT end with backslash (\)
Dim tmpFilePath As String
Dim sComm As String
Dim taskId As Long
Dim sLine As String
Dim lDepth As Long
Dim mPaths() As String
Dim curDeeperFolder As String
tmpFilePath = GetTempFile
sComm = "cmd /c dir " + cmDbl + Folder + "\*" + cmDbl + " /ad /s /b > " + cmDbl + tmpFilePath + cmDbl
Err.Clear
On Error GoTo Hell
taskId = Shell(sComm, vbHide)
Do While FileLen(tmpFilePath) = 0
DoEvents
Loop
lDepth = 0
curDeeperFolder = sEmpty
Open tmpFilePath For Input Access Read As #1
Do While Not EOF(1)
Line Input #1, sLine
If sLine <> sEmpty Then
If InStr(1, sLine, "\") > 0 Then
mPaths = Split(sLine, "\")
If UBound(mPaths) > lDepth Then
lDepth = UBound(mPaths)
curDeeperFolder = sLine
End If
End If
End If
Loop
Close #1
Kill tmpFilePath
getDeeperPath = curDeeperFolder
Exit Function
Hell:
MsgBox "Error in getDeeperPath: " & Err.Description
End Function
Function GetTempDir() As String
Dim sRet As String, c As Long
sRet = String(cMaxPath, 0)
c = GetTempPath(cMaxPath, sRet)
'If c = 0 Then ApiRaise Err.LastDllError
GetTempDir = Left$(sRet, c)
End Function
Function GetTempFile(Optional Prefix As String, Optional PathName As String) As String
Dim sRet As String
If Prefix = sEmpty Then Prefix = sEmpty
If PathName = sEmpty Then PathName = GetTempDir
sRet = String(260, 0)
GetTempFileName PathName, Prefix, 0, sRet
'GetTempFile = GetFullPath(StrZToStr(sRet))
GetTempFile = StrZToStr(sRet)
End Function
' Strip junk at end from null-terminated string
Function StrZToStr(s As String) As String
StrZToStr = Left$(s, lstrlen(s))
End Function
Mostrar Mensajes
