crear lista en hoja de todas las carpetas que tiene un archivo

hola, daniel !

Poner en una hoja todas las carpetas que tiene una carpeta no archivos
es decir que me cree una lista con la ruta de las carpetas que hay dentro de Ej. C:\Documents and Settings\DANIEL\Escritorio\excel/
solo las carpetas los archivos no

existen varias formas... el siguiente ejemplo es una de ellas:
copia las lineas de codigo que adjunto al final y 'corre' unas pruebas =>pero antes<= ...
1) agrega una referencia en el proyecto a la libreria =>Microsoft Scripting Runtime< [C:\Windows\System\ScrRun.dll]
=> en el editor de vba ... herramientas -> referencias
2) la macro 'limpia' las columnas [enteras] de la celda 'activa' y 'la siguiente' [derecha]
3) 'escribe' [desde la celda activa] un listado de directorios 'a partir' de la ruta especificada
[yo use para el ejemplo =>"c:mis documentos:\"<=]
=>puede ser 'a partir de' un [sub]directorio o una unidad logica 'completa' [raiz]<4) la lista se obtiene 'tal cual' estan 'depositados' en el disco duro [posiblemente 'desordenados']

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

Public fso As New FileSystemObject, Carpeta As Folder, SubCarpeta As Folders, _
Sub_Dir As Variant, TotalCarpetas As Integer, Elemento As Integer, _
Carpetas() As Variant, Matriz() As Variant
Sub ListarCarpetas():
Application.ScreenUpdating = False
Dim Iniciar_en As String
Iniciar_en = "c:\mis documentos\"
Elemento = 0: Range(ActiveCell, ActiveCell.Offset(, 1)).EntireColumn.ClearContents
ActiveCell = "Existen " & ContarCarpetas(Iniciar_en) & " subcarpetas en " & Iniciar_en
For Elemento = 1 To UBound(Carpetas): ActiveCell.Offset(Elemento) = Carpetas(Elemento): Next
ActiveCell.EntireColumn.AutoFit: Application.ScreenUpdating = True
End Sub
Private Function ContarCarpetas(ByVal RutaDeInicio As String) As Integer
If Right(RutaDeInicio, 1) <> "\" Then RutaDeInicio = RutaDeInicio & "\"
On Error GoTo Horrores
Set fso = CreateObject("Scripting.FileSystemObject")
Set Carpeta = fso.GetFolder(RutaDeInicio): Set SubCarpeta = Carpeta.SubFolders
ReDim Preserve Carpetas(Elemento): Carpetas(Elemento) = Carpeta.Path
Elemento = Elemento + 1: TotalCarpetas = SubCarpeta.Count
For Each Sub_Dir In SubCarpeta
TotalCarpetas = TotalCarpetas + ContarCarpetas(RutaDeInicio & Sub_Dir.Name)
Next
FinDeFuncion:
ContarCarpetas = TotalCarpetas
Set SubCarpeta = Nothing: Set Carpeta = Nothing: Set fso = Nothing: Exit Function
Horrores:
Resume FinDeFuncion
End Function

Hola Hector Miguel
1)muchas gracias por yu ayuda pero me da un error
en la linea esta: se marca esto de amarillo
For Elemento = 1 To UBound(Carpetas)
el error es el "9" sub indice fuera de intervalo
e verificado que este bien la ruta y que esista y nada no va


2)si lo puedes solucionar como seria para agregar la referencia en el
proyecto a la biblioteca [C:\Windows\System\ScrRun.dll]
autoimaticamente mediante macro para que en el ordenador que no la tenga que
la registre automaticamente.

3)sobre el post anterior que puse sobre crear muchos label automaticamente
se puedde hacer o es imposible hacer eso
o me e explicado mal.


un saqludo y muchisimas gracias
Daniel
"Héctor Miguel" escribió en el mensaje
news:

hola, daniel !

Poner en una hoja todas las carpetas que tiene una carpeta no archivos
es decir que me cree una lista con la ruta de las carpetas que hay dentro
de Ej. C:\Documents and Settings\DANIEL\Escritorio\excel/
solo las carpetas los archivos no

existen varias formas... el siguiente ejemplo es una de ellas:
copia las lineas de codigo que adjunto al final y 'corre' unas pruebas
=>pero antes<= ...
1) agrega una referencia en el proyecto a la libreria =>Microsoft
Scripting Runtime<> [C:\Windows\System\ScrRun.dll]
=> en el editor de vba ... herramientas -> referencias
2) la macro 'limpia' las columnas [enteras] de la celda 'activa' y 'la
siguiente' [derecha]
3) 'escribe' [desde la celda activa] un listado de directorios 'a partir'
de la ruta especificada
[yo use para el ejemplo =>"c:mis documentos:\"<=]
=>puede ser 'a partir de' un [sub]directorio o una unidad logica
'completa' [raiz]<> 4) la lista se obtiene 'tal cual' estan 'depositados' en el disco duro
[posiblemente 'desordenados']

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

Public fso As New FileSystemObject, Carpeta As Folder, SubCarpeta As
Folders, _
Sub_Dir As Variant, TotalCarpetas As Integer, Elemento As
Integer, _
Carpetas() As Variant, Matriz() As Variant
Sub ListarCarpetas():
Application.ScreenUpdating = False
Dim Iniciar_en As String
Iniciar_en = "c:\mis documentos\"
Elemento = 0: Range(ActiveCell, ActiveCell.Offset(,
1)).EntireColumn.ClearContents
ActiveCell = "Existen " & ContarCarpetas(Iniciar_en) & " subcarpetas en "
& Iniciar_en
For Elemento = 1 To UBound(Carpetas): ActiveCell.Offset(Elemento) =
Carpetas(Elemento): Next
ActiveCell.EntireColumn.AutoFit: Application.ScreenUpdating = True
End Sub
Private Function ContarCarpetas(ByVal RutaDeInicio As String) As Integer
If Right(RutaDeInicio, 1) <> "\" Then RutaDeInicio = RutaDeInicio & "\"
On Error GoTo Horrores
Set fso = CreateObject("Scripting.FileSystemObject")
Set Carpeta = fso.GetFolder(RutaDeInicio): Set SubCarpeta =
Carpeta.SubFolders
ReDim Preserve Carpetas(Elemento): Carpetas(Elemento) = Carpeta.Path
Elemento = Elemento + 1: TotalCarpetas = SubCarpeta.Count
For Each Sub_Dir In SubCarpeta
TotalCarpetas = TotalCarpetas + ContarCarpetas(RutaDeInicio &
Sub_Dir.Name)
Next
FinDeFuncion:
ContarCarpetas = TotalCarpetas
Set SubCarpeta = Nothing: Set Carpeta = Nothing: Set fso = Nothing: Exit
Function
Horrores:
Resume FinDeFuncion
End Function

hola, daniel !

1) ... me da un error en la linea esta: se marca esto de amarillo
For Elemento = 1 To UBound(Carpetas)
el error es el "9" sub indice fuera de intervalo e verificado que este bien la ruta y que esista y nada no va [...]
2) si lo puedes solucionar como seria para agregar la referencia en el proyecto a la biblioteca [C:\Windows\System\ScrRun.dll]
autoimaticamente mediante macro para que en el ordenador que no la tenga que la registre automaticamente [...]
3) sobre el post anterior que puse sobre crear muchos label automaticamente se puedde hacer o es imposible hacer eso
o me e explicado mal.

1) hare unas pruebas adicionales porque no he logrado reproducir el error :(
probablemente se deba a alguna declaracion 'implicita' o... -???-

2) una vez que estableces referencias en tu proyecto de macros, quedan adheridas como corresponde
[o sea, no es necesario elaborar rutinas de instalacion adicionales]
podrian llegar a fallar, si en el equipo donde se ejecuten NO esta disponible dicha libreria
tampoco creo que podrias hacer mucho por macros, si el caso es que dicha libreria no se encuentra en ese equipo -?-

3) con respecto de 'esa' consulta...
a) el codigo que expones es 'ligeramente' distinto de la intencion plasmada en el asunto de la consulta -?-
b) no diste aun respuesta a las preguntas que te hacia :-((
-> dejame ver si puedo 'adivinar' lo que no expusiste en el otro post :D

saludos,
hector.

hola Hector Miguel
muchas gracias de nuevo por ayudarme
cuando tengas la solucion de lo del error me lo comentas.
a la pregunta esta que me hiciste
1) supongo que 'la fila de nombres'... de algun modo/lugar/origen/...
'llego' al listbox...
-> podrias exponer este 'detalle' ?... [de preferencia, +/- exactamente]
:))
con el codigo que te espuse crea una lista con todos los archivos que hay en
la carpeta
en la hoja en la olumna A pone el tamaño en bit y en la B la ruta completa
del archivo luego
con ListBox1.RowSource = ("$b$2:$b$1000") las rutas las muestro en el
listbox1.
a la pregunta :
2) si el 'origen' de los nombres [y las rutas de sus archivos de imagen]
'viene' de algun listado en hoja de excel...
-> cual seria la necesidad de 'duplicarlos' [pero ahora] como objetos
incrustados en alguna hoja ?
-> y ademas incrustar el mismo numero de nombres/rutas con sus objetos
imagen ?
No los label quiero que se creen en el userform no en la hoja de calculo
como objetos incrustados.
tanta cantidad de label como archivos haiga en el listbox.
y que en el caption del label aparezca la ruta y en el icono la imagen.

a la pregunta:
3) que significa 'colocar los label en columnas de 10' ???
-> de cuantos objetos INCRUSTADOS en hojas [labels y fotos] estariamos
hablando en total ???
me refiero que en el userform colocar los label de filas de 10 dejando
espacio entre cada uno ,no poner todos en el mismo sitio
Ej. si tengo 100 archivos que haiga 10 filas con 10 label cada fila.

siento no poder ser mas esplicativo.
un saludo y muchas gracias
daniel


"Héctor Miguel" escribió en el mensaje
news:

hola, daniel !

1) ... me da un error en la linea esta: se marca esto de amarillo
For Elemento = 1 To UBound(Carpetas)
el error es el "9" sub indice fuera de intervalo e verificado que este
bien la ruta y que esista y nada no va [...]
2) si lo puedes solucionar como seria para agregar la referencia en el
proyecto a la biblioteca [C:\Windows\System\ScrRun.dll]
autoimaticamente mediante macro para que en el ordenador que no la tenga
que la registre automaticamente [...]
3) sobre el post anterior que puse sobre crear muchos label
automaticamente se puedde hacer o es imposible hacer eso
o me e explicado mal.

1) hare unas pruebas adicionales porque no he logrado reproducir el error
:(
probablemente se deba a alguna declaracion 'implicita' o... -???-

2) una vez que estableces referencias en tu proyecto de macros, quedan
adheridas como corresponde
[o sea, no es necesario elaborar rutinas de instalacion adicionales]
podrian llegar a fallar, si en el equipo donde se ejecuten NO esta
disponible dicha libreria
tampoco creo que podrias hacer mucho por macros, si el caso es que
dicha libreria no se encuentra en ese equipo -?-

3) con respecto de 'esa' consulta...
a) el codigo que expones es 'ligeramente' distinto de la intencion
plasmada en el asunto de la consulta -?-
b) no diste aun respuesta a las preguntas que te hacia :-((
-> dejame ver si puedo 'adivinar' lo que no expusiste en el otro post
:D

saludos,
hector.

hola, daniel !

cuando tengas la solucion de lo del error me lo comentas.

1) el error se refiere a que la ruta que se pasa como inicial NO existe ;)
en el ejemplo estoy utilizando un supuesto de: -> Iniciar_en = "c:\mis documentos\"
-> es necesario que tu establezcas la ruta donde se iniciara la busqueda de directorios :D
[aunque ya te lo habia comentado en el punto 3] ;)

2) con relacion al tema de las imagenes y el 'monton' de labels [aun dentro de un formulario]...
-> creo que seria mejor utilizar solo un combobox con las opciones de imagenes...
y un solo control de imagen que muestre segun seleccion en el combo -?-

-> ademas de que en el codigo estas usando un objeto 'FileSearch' [y tiene sus... 'imponderables'] ;)
tampoco acabo de entender la necesidad de poner hipervinculos en las celdas de la hoja -?-
por lo que serviria si comentas 'que' es lo que *realmente* buscas como objetivo final con tantos labels e imagenes -???-

saludos,
hector.

__ el resto de la consulta __

a la pregunta esta que me hiciste
1) supongo que 'la fila de nombres'... de algun modo/lugar/origen/... 'llego' al listbox...
-> podrias exponer este 'detalle' ?... [de preferencia, +/- exactamente] :))
con el codigo que te espuse crea una lista con todos los archivos que hay en la carpeta
en la hoja en la olumna A pone el tamaño en bit y en la B la ruta completa del archivo luego
con ListBox1.RowSource = ("$b$2:$b$1000") las rutas las muestro en el listbox1.

a la pregunta :
2) si el 'origen' de los nombres [y las rutas de sus archivos de imagen] 'viene' de algun listado en hoja de excel...
-> cual seria la necesidad de 'duplicarlos' [pero ahora] como objetos incrustados en alguna hoja ?
-> y ademas incrustar el mismo numero de nombres/rutas con sus objetos imagen ?
No los label quiero que se creen en el userform no en la hoja de calculo como objetos incrustados.
tanta cantidad de label como archivos haiga en el listbox.
y que en el caption del label aparezca la ruta y en el icono la imagen.

a la pregunta:
3) que significa 'colocar los label en columnas de 10' ???
-> de cuantos objetos INCRUSTADOS en hojas [labels y fotos] estariamos hablando en total ???
me refiero que en el userform colocar los label de filas de 10 dejando espacio entre cada uno ,no poner todos en el mismo sitio
Ej. si tengo 100 archivos que haiga 10 filas con 10 label cada fila.