Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Macro Listar dir() carpetas y listar dir() Subcarpetas error

18 views
Skip to first unread message

Inés Gómez Benavent

unread,
Jun 29, 2017, 4:00:00 AM6/29/17
to
Hola a todos, tengo hecha una macro que lista carpetas de 1 ruta y después con los datos de la 1 lista saco 2 lista de carpetas. Pero se ve al listar la 2 ruta se guarda en los datos de la 1, nose como hacer que cada una tenga su lista.

'mySourcePath es la ruta princpical de la 1 lista
Sub ListMyFiles(mySourcePath)
mySourcePath = mySourcePath & "\"
Dim fList As String
Dim fLists As String
Dim fName As String
Dim fNames As String
Dim numero As String
numero = 0
iRow = 2
For inicios = 0 To Total
fName = Dir(mySourcePath, vbDirectory)
' The variable fName now contains the name of the first file or directory within "C:\".
If InStr(fNames, ".") > 0 Then
numero = Left(fNames, InStr(fNames, ".") - 1)
ElseIf InStr(fNames, "..") > 0 Then
numero = Left(fNames, InStr(fNames, "..") - 1)
End If
If numero = "" Then
inicios = 0
End If
Do While fName <> ""
' Store the current file or directory name in the string fList.
fList = fList & vbNewLine & fName
datos = Range("A" & iRow).Value
aux = 0
MsgBox "Ruta 1.1: " & fList
MsgBox "Datos: " & datos
If datos <> fName Then
fName = Dir()
ElseIf datos = fName Then
'la otra ruta modifica para que lista otras carpetas
rutas = mySourcePath & fName & "\ASUNTOS\"
fNames = Dir(rutas, vbDirectory)
Do While fNames <> ""
'fLists = fLists & vbNewLine & fNames
' Get the next file or directory within "C:\".
If InStr(fNames, ".") > 0 Then
numero = Left(fNames, InStr(fNames, ".") - 1)
ElseIf InStr(fNames, "-") > 0 Then
numero = Left(fNames, InStr(fNames, "-") - 1)
ElseIf InStr(fNames, "_") > 0 Then
numero = Left(fNames, InStr(fNames, "_") - 1)
End If
If numero = "" Then
fNames = Dir()
End If
If numero <> "" Then
iRows = 2
For inicio = 0 To Total
dato = Range("B" & iRows).Value
If dato = numero Then
Range("F" & iRows).Value = numero
ruta = fNames + numero
ActiveSheet.Hyperlinks.Add Anchor:=Cells(iRows, "E"), Address:=ruta, TextToDisplay:=numero
End If
If dato <> numero Then
End If
If dato = "" Then
End If
iRows = iRows + 1
Next inicio
fNames = Dir()
End If
Loop
iRow = iRow + 1
End If
Loop
fName = fName
fName = Dir()
iRow = iRow + 1
Next inicios
End Sub
Total es cuantos datos hay en las columna E, que lo recorro con un For para comprar los datos, si es igual al nombre de la carpeta.
Busco en sub carpetas si existe un nombre de la columna H, que se llame igual y si es así hago el hipervínculo.
Ejemplo:
Columna E Columna H
500 Alfredo
752 Maria
800 Ana
450 Ethan
1052 Alvaro

Rutas:
C:\Users\usuario\Documents\500
C:\Users\usuario\Documents\800
C:\Users\usuario\Documents\450
C:\Users\usuario\Documents\500\ASUNTOS\Maria
C:\Users\usuario\Documents\500\ASUNTOS\Alvaro
C:\Users\usuario\Documents\800\ASUNTOS\Ana

En fList me sale:
.
..
500
500

Tendría que salir:
.
..
500
752
0 new messages