Listar rutas de carpetas dentro de otra carpeta
Soy muy nuevo en esto, he empezado hace poco con las macros y es algo que me parece interesante, de momento voy investigando con las que me bajo, las voy modificando a mis necesidades.
Ahora necesito para el trabajo lo siguiente:
Supongamos que tengo una carpeta, la llamaremos "BASE" (hasta aquí se entiende todo. ¿No? :s)
Y dentro de esta carpeta tengo muchas carpetas, supongamos:
BASE->
0001
0002
0003
0004
0005
0006
0007
0008
Etc..
Dentro de cada carpeta numérica tengo ficheros PDF.
Lo que yo necesito, es hacer (bueno, más bien que alguien me haga o me asesore.) Una macro en Excel que me haga un listado de las carpetas numéricas, sólo de las carpetas no de lo que contienen, y a su vez, al pinchar en la celda de una carpeta me abra dicha carpeta, o sea, un hipervínculo a estas carpetas numéricas.
También sería bueno, que al abrir el Excel se ejecutara la macro, así se actualizaría el Excel puesto que a la carpeta "BASE" se añaden carpetas numéricas a diario.
Espero que haya dejado claro lo que necesito. Para cualquier otra aclaración me escribís.
Ahora necesito para el trabajo lo siguiente:
Supongamos que tengo una carpeta, la llamaremos "BASE" (hasta aquí se entiende todo. ¿No? :s)
Y dentro de esta carpeta tengo muchas carpetas, supongamos:
BASE->
0001
0002
0003
0004
0005
0006
0007
0008
Etc..
Dentro de cada carpeta numérica tengo ficheros PDF.
Lo que yo necesito, es hacer (bueno, más bien que alguien me haga o me asesore.) Una macro en Excel que me haga un listado de las carpetas numéricas, sólo de las carpetas no de lo que contienen, y a su vez, al pinchar en la celda de una carpeta me abra dicha carpeta, o sea, un hipervínculo a estas carpetas numéricas.
También sería bueno, que al abrir el Excel se ejecutara la macro, así se actualizaría el Excel puesto que a la carpeta "BASE" se añaden carpetas numéricas a diario.
Espero que haya dejado claro lo que necesito. Para cualquier otra aclaración me escribís.
11 respuestas
Respuesta de Jose Miguel
1
Bueno existen muchas maneras de hacerlo, me parece que una de las más fáciles es la siguiente:
1. En un libro cualquier en la celda A1, coloca el path desde el cual quieres obtener el listado de subcarpetas, en tu caso el Folder sería c:\Base,
2. Agrega un Módulo cualquiera y pega el siguiente código:
' Método principal que prepara la información
Sub GetListFolders()
Application.ScreenUpdating = False
Dim Folder As String
Folder = Range("A1")
Range("A2") = "Carpetas contenidas en: " & Folder
GetListAction Folder
End Sub
' Metodo para barrer los subfolders..
Sub GetListAction(ByVal Folder As String)
Dim SubFolder, File As Long
File = Range("A1048576").End(xlUp).Row + 1
With CreateObject("scripting.filesystemobject")
With .GetFolder(Folder)
For Each SubFolder In .SubFolders
With SubFolder
Range("A" & File) = SubFolder.Name
End With
File = File + 1
Next
End With
End With
Range("a1").EntireColumn.AutoFit
Debug.Print ActiveSheet.UsedRange.Address
End Sub
Sub GetListFolders() Application.ScreenUpdating = False Dim Folder As String Folder = Range("A1") Range("A2") = "Carpetas contenidas en: " & Folder GetListAction FolderEnd SubSub GetListAction(ByVal Folder As String) Dim SubFolder, File As Long File = Range("A1048576").End(xlUp).Row + 1 With CreateObject("scripting.filesystemobject") With .GetFolder(Folder) For Each SubFolder In .SubFolders With SubFolder Range("A" & File) = SubFolder.Name End With File = File + 1 Next End With End With
Range("a1").EntireColumn.AutoFit
End Sub
Con este módulo en listas las carpetas, ahora para que se habrán las carpetas no puedes usar un hipervínculo ya que este funciona solo apuntando a archivos, mañana te escribo el complemento de esta respuesta.
Saludos,
JM
1. En un libro cualquier en la celda A1, coloca el path desde el cual quieres obtener el listado de subcarpetas, en tu caso el Folder sería c:\Base,
2. Agrega un Módulo cualquiera y pega el siguiente código:
' Método principal que prepara la información
Sub GetListFolders()
Application.ScreenUpdating = False
Dim Folder As String
Folder = Range("A1")
Range("A2") = "Carpetas contenidas en: " & Folder
GetListAction Folder
End Sub
' Metodo para barrer los subfolders..
Sub GetListAction(ByVal Folder As String)
Dim SubFolder, File As Long
File = Range("A1048576").End(xlUp).Row + 1
With CreateObject("scripting.filesystemobject")
With .GetFolder(Folder)
For Each SubFolder In .SubFolders
With SubFolder
Range("A" & File) = SubFolder.Name
End With
File = File + 1
Next
End With
End With
Range("a1").EntireColumn.AutoFit
Debug.Print ActiveSheet.UsedRange.Address
End Sub
Sub GetListFolders() Application.ScreenUpdating = False Dim Folder As String Folder = Range("A1") Range("A2") = "Carpetas contenidas en: " & Folder GetListAction FolderEnd SubSub GetListAction(ByVal Folder As String) Dim SubFolder, File As Long File = Range("A1048576").End(xlUp).Row + 1 With CreateObject("scripting.filesystemobject") With .GetFolder(Folder) For Each SubFolder In .SubFolders With SubFolder Range("A" & File) = SubFolder.Name End With File = File + 1 Next End With End With
Range("a1").EntireColumn.AutoFit
End Sub
Con este módulo en listas las carpetas, ahora para que se habrán las carpetas no puedes usar un hipervínculo ya que este funciona solo apuntando a archivos, mañana te escribo el complemento de esta respuesta.
Saludos,
JM
Takki,
Prueba este macro, lo modifique para que coloque el acceso directo junto al nombre de la subcarpeta.
Sub GetListFolders()
Application.ScreenUpdating = False
Dim Folder As String
Folder = Range("A1")
Range("A2:B2") = Array("Carpetas contenidas en: " & Folder, "Acceso Directo")
GetListAction Folder
Application.ScreenUpdating = True
End Sub
Sub GetListAction(ByVal Folder As String)
Dim SubFolder, File As Long
File = Range("A1048576").End(xlUp).Row + 1
With CreateObject("scripting.filesystemobject")
With .GetFolder(Folder)
For Each SubFolder In .SubFolders
With SubFolder
Range("A" & File) = SubFolder.Name
'Range("A" & File).Select
'Range("A" & File).Hyperlinks.Add Anchor:=Selection, Address:=SubFolder.Name, _
TextToDisplay:=SubFolder.Name
Range("B" & File).FormulaR1C1 = "=HYPERLINK(""" & SubFolder & """,""" & SubFolder.Name & """ )"
End With
File = File + 1
Next
End With
End With
Range("a1").EntireColumn.AutoFit
End Sub
Sub GetListFolders() Application.ScreenUpdating = False Dim Folder As String Folder = Range("A1") Range("A2:B2") = Array("Carpetas contenidas en: " & Folder, "Acceso Directo") GetListAction Folder Application.ScreenUpdating = TrueEnd SubSub GetListAction(ByVal Folder As String) Dim SubFolder, File As Long File = Range("A1048576").End(xlUp).Row + 1 With CreateObject("scripting.filesystemobject") With .GetFolder(Folder) For Each SubFolder In .SubFolders With SubFolder Range("A" & File) = SubFolder.Name
Range("B" & File).FormulaR1C1 = "=HYPERLINK(""" & SubFolder & """,""" & SubFolder.Name & """ )" End With File = File + 1 Next End With End With
Range("a1").EntireColumn.AutoFit End Sub
Prueba este macro, lo modifique para que coloque el acceso directo junto al nombre de la subcarpeta.
Sub GetListFolders()
Application.ScreenUpdating = False
Dim Folder As String
Folder = Range("A1")
Range("A2:B2") = Array("Carpetas contenidas en: " & Folder, "Acceso Directo")
GetListAction Folder
Application.ScreenUpdating = True
End Sub
Sub GetListAction(ByVal Folder As String)
Dim SubFolder, File As Long
File = Range("A1048576").End(xlUp).Row + 1
With CreateObject("scripting.filesystemobject")
With .GetFolder(Folder)
For Each SubFolder In .SubFolders
With SubFolder
Range("A" & File) = SubFolder.Name
'Range("A" & File).Select
'Range("A" & File).Hyperlinks.Add Anchor:=Selection, Address:=SubFolder.Name, _
TextToDisplay:=SubFolder.Name
Range("B" & File).FormulaR1C1 = "=HYPERLINK(""" & SubFolder & """,""" & SubFolder.Name & """ )"
End With
File = File + 1
Next
End With
End With
Range("a1").EntireColumn.AutoFit
End Sub
Sub GetListFolders() Application.ScreenUpdating = False Dim Folder As String Folder = Range("A1") Range("A2:B2") = Array("Carpetas contenidas en: " & Folder, "Acceso Directo") GetListAction Folder Application.ScreenUpdating = TrueEnd SubSub GetListAction(ByVal Folder As String) Dim SubFolder, File As Long File = Range("A1048576").End(xlUp).Row + 1 With CreateObject("scripting.filesystemobject") With .GetFolder(Folder) For Each SubFolder In .SubFolders With SubFolder Range("A" & File) = SubFolder.Name
Range("B" & File).FormulaR1C1 = "=HYPERLINK(""" & SubFolder & """,""" & SubFolder.Name & """ )" End With File = File + 1 Next End With End With
Range("a1").EntireColumn.AutoFit End Sub
Muchas gracias por tu rápida respuesta,
Lo que me comentaste en tu segunda contestación es lo que necesitaba.
Un placer.
Saludos.
Lo que me comentaste en tu segunda contestación es lo que necesitaba.
Un placer.
Saludos.
Respuesta de mcariash
1
Este es el código que necesitas para listar las carpetas con su respectivo hipervínculo:
1. Pega este código en en ThisWorkbook de tu libro de excel.
Private Sub Workbook_Open()
ruta = "C:\Documents and Settings\Usuario\Mis documentos\"
Set filesys = CreateObject("scripting.filesystemobject")
Set Folders = filesys.getfolder(ruta)
Application.ScreenUpdating = True
ActiveSheet.Range("B4").Select
For Each folder In Folders.subfolders
ActiveCell.Value = folder.Name
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=folder
ActiveCell.Offset(1).Select
Next
End Sub
2. Cambia el valor de la variable ruta por la ruta de donde esta tu carpeta raíz (para el ejemplo que me diste, seria la ruta de la carpeta BASE) y deja el "\" al final de dicha ruta.
3. En el editor de Visual Basci de Excel ir al menu Herramientas-->Referencias y verificar que la opción Microsoft Forms 2.0 Object Library este marcada.
4. Baja el nivel se seguridad de macros a medio o bajo como tu quieras para que la macro se ejecute automáticamente y excel no te pregunte nada.
Cualquier duda no dudes en preguntar...
1. Pega este código en en ThisWorkbook de tu libro de excel.
Private Sub Workbook_Open()
ruta = "C:\Documents and Settings\Usuario\Mis documentos\"
Set filesys = CreateObject("scripting.filesystemobject")
Set Folders = filesys.getfolder(ruta)
Application.ScreenUpdating = True
ActiveSheet.Range("B4").Select
For Each folder In Folders.subfolders
ActiveCell.Value = folder.Name
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=folder
ActiveCell.Offset(1).Select
Next
End Sub
2. Cambia el valor de la variable ruta por la ruta de donde esta tu carpeta raíz (para el ejemplo que me diste, seria la ruta de la carpeta BASE) y deja el "\" al final de dicha ruta.
3. En el editor de Visual Basci de Excel ir al menu Herramientas-->Referencias y verificar que la opción Microsoft Forms 2.0 Object Library este marcada.
4. Baja el nivel se seguridad de macros a medio o bajo como tu quieras para que la macro se ejecute automáticamente y excel no te pregunte nada.
Cualquier duda no dudes en preguntar...
Muchas gracias, es correcto lo que me envías, lo que me hacía falta... pero, siempre hay un "pero", pensando después, te cuento mi caso:
Trabajo con una carpeta "C:\IMAGES" dentro de la cual, hay más carpetas:
C:\IMAGES -->
505050
505051
505052
505053
505054
... etc
Cada una de estas carpetas numéricas contiene un PDF y un archivo de texto .txt, cada día se van creando más carpetas numéricas dentro de " C:\IMAGES ".
Mediante el tu código (GRACIAS), he conseguido listar las carpetas numéricas, y a la vez, al pinchar sobre una, que me abra dicha carpeta, o sea, crear hipervínculos a estas carpetas (a las numéricas):
********************************************************
Private Sub Workbook_Open()
ruta = "C:\IMAGES\"
Set filesys = CreateObject("scripting.filesystemobject")
Set Folders = filesys.getfolder(ruta)
Application.ScreenUpdating = True
ActiveSheet.Range("B4").Select
For Each folder In Folders.subfolders
ActiveCell.Value = folder.Name
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=folder
ActiveCell.Offset(1).Select
Next
End Sub
********************************************************
Hasta aquí todo correcto, pero ahora mi consulta es la siguiente, y no sé si se podrá hacer, es algo complicadillo.
-Tengo un programa de diseño técnico, que utiliza un PDF y un archivo de texto, el PDF como imagen y el archivo de texto como template o coordenadas, como recordarás que comenté más arriba, en cada carpeta numérica hay un PDF y un archivo .txt.
Este programa utiliza una carpeta predeterminada para trabajar, de la que coge el PDF y el .txt (C:\DIGIPRINT), lo que me gustaría conseguir, si se puede, es, que después de listar las carpetas numéricas en un Excel, al pinchar en una, me copie (copiar, no mover) el PDF y el .txt de esa carpeta numérica a la carpeta (C:\DIGIPRINT). Un PDF y un .txt es todo lo que contiene cada carpeta numérica, entonces sería, al pinchar una celda del listado de carpetas numéricas, copiar todo el contenido de dicha carpeta numérica a C:\DIGIPRINT.
Veras, todo esto sería para usarlo en el trabajo, para personas con pocos recursos informáticos y que no tuvieran que hacer muchos pasos, lo más importante sería listar las carpetas numéricas y poder copiar el contenido de la carpeta numérica que hace falta en ese momento a la carpeta C:\DIGIPRINT.
No sé si me he explicado bien, si pudieras ayudarme te lo agradecería, si necesitas más detalles no dudes en escribirme.
1000 GRACIAS!
Trabajo con una carpeta "C:\IMAGES" dentro de la cual, hay más carpetas:
C:\IMAGES -->
505050
505051
505052
505053
505054
... etc
Cada una de estas carpetas numéricas contiene un PDF y un archivo de texto .txt, cada día se van creando más carpetas numéricas dentro de " C:\IMAGES ".
Mediante el tu código (GRACIAS), he conseguido listar las carpetas numéricas, y a la vez, al pinchar sobre una, que me abra dicha carpeta, o sea, crear hipervínculos a estas carpetas (a las numéricas):
********************************************************
Private Sub Workbook_Open()
ruta = "C:\IMAGES\"
Set filesys = CreateObject("scripting.filesystemobject")
Set Folders = filesys.getfolder(ruta)
Application.ScreenUpdating = True
ActiveSheet.Range("B4").Select
For Each folder In Folders.subfolders
ActiveCell.Value = folder.Name
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=folder
ActiveCell.Offset(1).Select
Next
End Sub
********************************************************
Hasta aquí todo correcto, pero ahora mi consulta es la siguiente, y no sé si se podrá hacer, es algo complicadillo.
-Tengo un programa de diseño técnico, que utiliza un PDF y un archivo de texto, el PDF como imagen y el archivo de texto como template o coordenadas, como recordarás que comenté más arriba, en cada carpeta numérica hay un PDF y un archivo .txt.
Este programa utiliza una carpeta predeterminada para trabajar, de la que coge el PDF y el .txt (C:\DIGIPRINT), lo que me gustaría conseguir, si se puede, es, que después de listar las carpetas numéricas en un Excel, al pinchar en una, me copie (copiar, no mover) el PDF y el .txt de esa carpeta numérica a la carpeta (C:\DIGIPRINT). Un PDF y un .txt es todo lo que contiene cada carpeta numérica, entonces sería, al pinchar una celda del listado de carpetas numéricas, copiar todo el contenido de dicha carpeta numérica a C:\DIGIPRINT.
Veras, todo esto sería para usarlo en el trabajo, para personas con pocos recursos informáticos y que no tuvieran que hacer muchos pasos, lo más importante sería listar las carpetas numéricas y poder copiar el contenido de la carpeta numérica que hace falta en ese momento a la carpeta C:\DIGIPRINT.
No sé si me he explicado bien, si pudieras ayudarme te lo agradecería, si necesitas más detalles no dudes en escribirme.
1000 GRACIAS!
De nuevo Takki, claaro que si se puede hacer lo que tu dices, mira de la siguiente forma:
1. Reemplaza el código que te di antes por este que te coloco a continuación:
Private Sub Workbook_Open()
ruta = "C:\IMAGES\"
Set filesys = CreateObject("scripting.filesystemobject")
Set Folders = filesys.GetFolder(ruta)
Application.ScreenUpdating = True
ActiveSheet.Range("D6").Select
For Each Folder In Folders.subfolders
ActiveCell.Value = Folder.Name
ActiveCell.Offset(1).Select
Next
End Sub
2. En la hoja de VB donde va a quedar la lista de archivos coloca el siguiente codigo:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ruta = "C:\IMAGES\"
carpeta = ActiveCell.Value
rutat = ruta & carpeta
destino = "C:\DIGIPRINT\"
If Not Intersect(Target, Range(Cells(6, 4), Cells(65536, 4))) Is Nothing And Selection.Count = 1 Then
Dim Folder As New FileSystemObject
Set subcarpeta = Folder.GetFolder(rutat)
Set archivos = subcarpeta.Files
For Each archivo In archivos
Folder.CopyFile (archivo), destino
Next
MsgBox "Archivos Copiados Exitosamente"
End If
End Sub
3. La ejecución quedo de la siguiente manera:
3.1 Al Abrir el archivo se creara la lista de todas las carpetas de C:\IMAGES.
3.2 Al hacer doble clic en cada una de las celdas de la lista se copiaran todos los archivos de esa carpeta a C:\DIGIPRINT.
De nuevo te reitero, cualquier duda no dudes en preguntar...
1. Reemplaza el código que te di antes por este que te coloco a continuación:
Private Sub Workbook_Open()
ruta = "C:\IMAGES\"
Set filesys = CreateObject("scripting.filesystemobject")
Set Folders = filesys.GetFolder(ruta)
Application.ScreenUpdating = True
ActiveSheet.Range("D6").Select
For Each Folder In Folders.subfolders
ActiveCell.Value = Folder.Name
ActiveCell.Offset(1).Select
Next
End Sub
2. En la hoja de VB donde va a quedar la lista de archivos coloca el siguiente codigo:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ruta = "C:\IMAGES\"
carpeta = ActiveCell.Value
rutat = ruta & carpeta
destino = "C:\DIGIPRINT\"
If Not Intersect(Target, Range(Cells(6, 4), Cells(65536, 4))) Is Nothing And Selection.Count = 1 Then
Dim Folder As New FileSystemObject
Set subcarpeta = Folder.GetFolder(rutat)
Set archivos = subcarpeta.Files
For Each archivo In archivos
Folder.CopyFile (archivo), destino
Next
MsgBox "Archivos Copiados Exitosamente"
End If
End Sub
3. La ejecución quedo de la siguiente manera:
3.1 Al Abrir el archivo se creara la lista de todas las carpetas de C:\IMAGES.
3.2 Al hacer doble clic en cada una de las celdas de la lista se copiaran todos los archivos de esa carpeta a C:\DIGIPRINT.
De nuevo te reitero, cualquier duda no dudes en preguntar...
Hola, nuevamente muchas gracias por tu contestación.
En este segundo código me da un error, la primera parte lo hace bien, carga la lista de las carpetas numéricas, pero al hacer doble click sobre una de ellas me da error:
Marca en azul la línea "Dim Folder As New FileSystemObject" y sale un aviso: "Erro de compilación: No se ha definico el tipo definico por el usuario", le doy a aceptar y me marca en amarillo con una flechita la línea "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)", a ver si se puede solucionar.
Aún así te agradezco tu tiempo y ayuda, espero que acabe funcionando.
Saludos!
En este segundo código me da un error, la primera parte lo hace bien, carga la lista de las carpetas numéricas, pero al hacer doble click sobre una de ellas me da error:
Marca en azul la línea "Dim Folder As New FileSystemObject" y sale un aviso: "Erro de compilación: No se ha definico el tipo definico por el usuario", le doy a aceptar y me marca en amarillo con una flechita la línea "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)", a ver si se puede solucionar.
Aún así te agradezco tu tiempo y ayuda, espero que acabe funcionando.
Saludos!
Te pido disculpas, en la respuesta anterior se me olvido colocarte un paso que tocaba hacer para que no te apareciera este error justamente, es el siguiente, estando en el editor de visual basic de excel vas al menu Herramientsa-->Referencias y seleccionas la opción Microsoft Scripting Runtime, esta es la librería que te soporta el uso de FSO(File System Object) de la forma en que lo use en ese procedimiento.
Mil disculpas una vez más...
Mil disculpas una vez más...
Simplemente P E R F E C T O!!!!
Muchas y millones de GRACIAS mcariash!
Me lo has solucionado perfectamente :O)!
TE PONGO UN 20 sobre 10!
Saludos!
Muchas y millones de GRACIAS mcariash!
Me lo has solucionado perfectamente :O)!
TE PONGO UN 20 sobre 10!
Saludos!
Respuesta de proferay
1
La macro a continuación tendrás que copiarla en un módulo.
Ajusta el nombre de la carpeta y la referencia de la celda donde debe empezar la lista (en este ejemplo comenzará en la celda activa al momento de llamar la macro)
Sub ListaDeCarpetas()
Dim strCarpetas As String
Dim strCarpetaBase As String
'indicamos el nombre de la carpeta principal de donde tomará el nombre de las carpetas.
strCarpetaBase = "C:\BASE\"
'Ingresamos a la carpeta que contiene las otras carpetas numéricas.
ChDir strCarpetaBase
'Indicamos que sólo recoja las carpetas mediante el uso del comodín mas un punto,
' pero sin ninguna extensión de archivo.
strCarpetas = Dir("*.")
'Armamos una lista de las carpetas numéricas a partir de la celda activa.
Do While strCarpetas <> ""
ActiveCell.Value = "file://"&strCarpetas
ActiveCell.Offset(1, 0).Select
strCarpetas = Dir
Loop
End Sub
Al hacer clic sobre los vínculos abrirás las carpetas señaladas...
Ajusta el nombre de la carpeta y la referencia de la celda donde debe empezar la lista (en este ejemplo comenzará en la celda activa al momento de llamar la macro)
Sub ListaDeCarpetas()
Dim strCarpetas As String
Dim strCarpetaBase As String
'indicamos el nombre de la carpeta principal de donde tomará el nombre de las carpetas.
strCarpetaBase = "C:\BASE\"
'Ingresamos a la carpeta que contiene las otras carpetas numéricas.
ChDir strCarpetaBase
'Indicamos que sólo recoja las carpetas mediante el uso del comodín mas un punto,
' pero sin ninguna extensión de archivo.
strCarpetas = Dir("*.")
'Armamos una lista de las carpetas numéricas a partir de la celda activa.
Do While strCarpetas <> ""
ActiveCell.Value = "file://"&strCarpetas
ActiveCell.Offset(1, 0).Select
strCarpetas = Dir
Loop
End Sub
Al hacer clic sobre los vínculos abrirás las carpetas señaladas...
Hola,
muchas gracias por tu respuesta, pero de momento no consigo que haga lo que quiero, te comento:
Con lo que tu me pusiste, no lista ninguna carpeta,
si el comando strCarpetas = Dir("*.") lo modifico a strCarpetas = Dir("*.*"), me lista los archivos de la carpeta BASE, pero no las carpetas que hay dentro de BASE, y si dentro de BASE no hay archivos, sólo carpetas, no hace ninguna lista.
También he comprobado, que en el caso de listar archivos no crea vínculos hacie estos, aún así, mi necesidad sería vínculos a las carpetas.
A ver si se puede solucionar, si no, muchas gracias por tu contestación.
Saludos.
muchas gracias por tu respuesta, pero de momento no consigo que haga lo que quiero, te comento:
Con lo que tu me pusiste, no lista ninguna carpeta,
si el comando strCarpetas = Dir("*.") lo modifico a strCarpetas = Dir("*.*"), me lista los archivos de la carpeta BASE, pero no las carpetas que hay dentro de BASE, y si dentro de BASE no hay archivos, sólo carpetas, no hace ninguna lista.
También he comprobado, que en el caso de listar archivos no crea vínculos hacie estos, aún así, mi necesidad sería vínculos a las carpetas.
A ver si se puede solucionar, si no, muchas gracias por tu contestación.
Saludos.
Estuve viendo la posibilidad de crear un archivo de extensión ".bat" que pueda ejecutarse desde la línea de comandos del D.O.S. (Puedes usar "cmd" desde la opción "Ejecutar..." del Menú Inicio de Windows).
Sé que no es de Excel, pero pruébalo y fíjate si soluciona tu problema.
Dentro del archivo, incluir la sentencia:
dir /b c:\base\*. >carpetas.txt
Eso listará sólo las carpetas de la carpeta Base y las copiará en el archivo "carpetas.txt"
Con la opción "/b" evitas que se incorpore al archivo la información de directorio y de tamaños de carpetas y demás...
Se puede señalar una ruta específica para el archivo carpetas.txt (recuerda que si tiene espacios, como en el caso de "Mis Documentos", deberás encerrar todo entre comillas, por ejemplo: "c:\Mis Documentos\Pruebas de Excel\carpetas.txt").
Una vez que tienes el listado en el archivo ".txt", lo copias a una columna de una planilla Excel que posea formato "texto" (esto es para que te reconozca las carpetas "000001" como texto y no como número.
Supongamos que pones los datos en la columna "A"
En la columna "B1" ingresas: =HIPERVINCULO("file://C:\base\"&A1)
A partir de allí, tendrás acceso a cada carpeta como deseabas. (Cambia "base" por el nombre de tu carpeta y su correspondiente ruta).
Sé que es un poco más "a mano" pero funciona !
Sé que no es de Excel, pero pruébalo y fíjate si soluciona tu problema.
Dentro del archivo, incluir la sentencia:
dir /b c:\base\*. >carpetas.txt
Eso listará sólo las carpetas de la carpeta Base y las copiará en el archivo "carpetas.txt"
Con la opción "/b" evitas que se incorpore al archivo la información de directorio y de tamaños de carpetas y demás...
Se puede señalar una ruta específica para el archivo carpetas.txt (recuerda que si tiene espacios, como en el caso de "Mis Documentos", deberás encerrar todo entre comillas, por ejemplo: "c:\Mis Documentos\Pruebas de Excel\carpetas.txt").
Una vez que tienes el listado en el archivo ".txt", lo copias a una columna de una planilla Excel que posea formato "texto" (esto es para que te reconozca las carpetas "000001" como texto y no como número.
Supongamos que pones los datos en la columna "A"
En la columna "B1" ingresas: =HIPERVINCULO("file://C:\base\"&A1)
A partir de allí, tendrás acceso a cada carpeta como deseabas. (Cambia "base" por el nombre de tu carpeta y su correspondiente ruta).
Sé que es un poco más "a mano" pero funciona !
Hola,
gracias por tu respuesta, ya conseguí lo que quería con este código:
Sub GetListFolders()
Columns("A:E").Select
Selection.ClearContents
Range("A1").Select
'End Sub
Application.ScreenUpdating = False
Dim Folder As String
Folder = "C:\CLICHÉ"
Range("A1") = Array("LISTADO ALUMINIOS DIGIPRINT")
GetListAction Folder
Application.ScreenUpdating = True
End Sub
Sub GetListAction(ByVal Folder As String)
Dim SubFolder, File As Long
File = Range("A1048576").End(xlUp).Row + 1
With CreateObject("scripting.filesystemobject")
With .GetFolder(Folder)
For Each SubFolder In .SubFolders
With SubFolder
'Range("A" & File) = SubFolder.Name
'Range("A" & File).Select
'Range("A" & File).Hyperlinks.Add Anchor:=Selection, Address:=SubFolder.Name, TextToDisplay:=SubFolder.Name
Range("A" & File).FormulaR1C1 = "=HYPERLINK(""" & SubFolder & """,""" & SubFolder.Name & """ )"
End With
File = File + 1
Next
End With
End With
Range("a1").EntireColumn.AutoFit
End Sub
Gracias.
Saludos
gracias por tu respuesta, ya conseguí lo que quería con este código:
Sub GetListFolders()
Columns("A:E").Select
Selection.ClearContents
Range("A1").Select
'End Sub
Application.ScreenUpdating = False
Dim Folder As String
Folder = "C:\CLICHÉ"
Range("A1") = Array("LISTADO ALUMINIOS DIGIPRINT")
GetListAction Folder
Application.ScreenUpdating = True
End Sub
Sub GetListAction(ByVal Folder As String)
Dim SubFolder, File As Long
File = Range("A1048576").End(xlUp).Row + 1
With CreateObject("scripting.filesystemobject")
With .GetFolder(Folder)
For Each SubFolder In .SubFolders
With SubFolder
'Range("A" & File) = SubFolder.Name
'Range("A" & File).Select
'Range("A" & File).Hyperlinks.Add Anchor:=Selection, Address:=SubFolder.Name, TextToDisplay:=SubFolder.Name
Range("A" & File).FormulaR1C1 = "=HYPERLINK(""" & SubFolder & """,""" & SubFolder.Name & """ )"
End With
File = File + 1
Next
End With
End With
Range("a1").EntireColumn.AutoFit
End Sub
Gracias.
Saludos
Respuesta de algonzalezo
1
Creo o me parece que excel no tiene el alcance de realizar una búsqueda de archivos y actualizaciones dentro de win, pero si se puede hacer un vínculo entre excel y las carpetas.
¿Quieres qué te ayude con eso?
¿Quieres qué te ayude con eso?
Respuesta de prozac
1
Aquí tienes el código que debes insertar en un módulo.
Option Explicit
Sub Auto_open()
Call ListaCarpetas(Cells(1, 2).Value) 'ruta inicial
End Sub
Sub ListaCarpetas(ruta As String)
'Lista las carpetas a partir de la ruta origen en la columna A, desde A2
Dim nom As String 'nombre del directorio
Dim aux As String
Dim i As Integer
'limpio columna A y dejo el encabezado como estaba
Range("A:A").Clear
With Range("A1")
.Font.ColorIndex = 2
.HorizontalAlignment = xlRight
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
End With
Range("A1").Value = "Ruta: " 'coloco de nuevo el titulo
If (Right(ruta, 1) <> "\") Then ruta = ruta + "\" 'solo para windows
nom = Dir(ruta, vbDirectory)
i = 1
Do While nom <> ""
If (nom <> ".") And (nom <> "..") Then 'quito las referencias al actual y superior
aux = ruta & nom
If (GetAttr(aux) And vbDirectory) = vbDirectory Then
i = i + 1
aux = "file:///" & ruta & nom
ActiveSheet.Hyperlinks.Add anchor:=Range("A" & i), Address:=aux
End If
End If
nom = Dir ' siguiente entrada
Loop
End Sub
Para que te funcione tienes que escribir la ruta inicial (por ejemplo c:\base )en la celda A2 de la hoja activa. Si tienes problemas con el código deja tu email y te envío el fichero.
Adicionalmente puedes crear un botón en la hoja activa y asociarle el siguiente código para que puedas actualizar la lista sin tener que salir o ejecutar la macro desde las herramientas.
Private Sub CommandButton1_Click()
Call ListaCarpetas(Cells(1, 2).Value)
End Sub
Option Explicit
Sub Auto_open()
Call ListaCarpetas(Cells(1, 2).Value) 'ruta inicial
End Sub
Sub ListaCarpetas(ruta As String)
'Lista las carpetas a partir de la ruta origen en la columna A, desde A2
Dim nom As String 'nombre del directorio
Dim aux As String
Dim i As Integer
'limpio columna A y dejo el encabezado como estaba
Range("A:A").Clear
With Range("A1")
.Font.ColorIndex = 2
.HorizontalAlignment = xlRight
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
End With
Range("A1").Value = "Ruta: " 'coloco de nuevo el titulo
If (Right(ruta, 1) <> "\") Then ruta = ruta + "\" 'solo para windows
nom = Dir(ruta, vbDirectory)
i = 1
Do While nom <> ""
If (nom <> ".") And (nom <> "..") Then 'quito las referencias al actual y superior
aux = ruta & nom
If (GetAttr(aux) And vbDirectory) = vbDirectory Then
i = i + 1
aux = "file:///" & ruta & nom
ActiveSheet.Hyperlinks.Add anchor:=Range("A" & i), Address:=aux
End If
End If
nom = Dir ' siguiente entrada
Loop
End Sub
Para que te funcione tienes que escribir la ruta inicial (por ejemplo c:\base )en la celda A2 de la hoja activa. Si tienes problemas con el código deja tu email y te envío el fichero.
Adicionalmente puedes crear un botón en la hoja activa y asociarle el siguiente código para que puedas actualizar la lista sin tener que salir o ejecutar la macro desde las herramientas.
Private Sub CommandButton1_Click()
Call ListaCarpetas(Cells(1, 2).Value)
End Sub
Respuesta de ass1968
1
¿No entiendo cuando me hablas de carpetas? Me puedes enviar archivo para tener más claridad.
Un abrazo
Un abrazo
Respuesta de canapone
1
Lo siento si contesto tarde, y si mi Español no es correcto: no sé de Visual Basic.
Y lo siento mucho.
Yo sólo soy un usuario avanzado de Excel.
Estoy aprendiendo mucho de el Foro.
Y lo siento mucho.
Yo sólo soy un usuario avanzado de Excel.
Estoy aprendiendo mucho de el Foro.
Respuesta de solnegro
1
Primero que nada permíteme decirte (perdón si suena a regaño) pero este es un foro de ayuda si deseas que alguien "Te haga" tus programas pues hay muchas empresas que se dedican al desarrollo de software o en dado caso toda asesoría genera honorarios
ahora una vez mencionados los fundamentos del foro pasemos a lo importante que es tu duda pues yo tengo un una macro que realize la cual te podría ser de utilidad tendrías que modificarla a tu conveniencia te comento lo que hace
en base a una página principal seleccionas una carpeta la cual (en mi caso busca archivos en excel) dentro de esa carpeta muestra todos los archivos, cuando se le da aceptar toma la ruta seleccionada, después en una celda especifica ingresamos el dato a buscar y dentro de esa carpeta y en cada uno de los archivos busca el dato ingresado y muestra en las celdas siguientes el nombre del archivo, la hoja y la celda en la que se encuentra dicho dato. Estoy consiente que no es lo que buscas pero podría ser un inicio de algo te ha de servir mi macro no esta terminada pues no he colocado los hipervínculos para que se abra automáticamente el archivo
pero vuelvo a decirlo de algo te ha de servir enviame un correo y te lo mando con gusto y pues
y pues estoy dispuesto a ayudar si tu estas dispuesto a investigar y no esperar a que te lo hagan es más si entre los dos podemos mejorar mi macro seria genial así los dos ganamos =D
pero bueno espero te sea de utilidad y cualquier duda no dudes en preguntar que para eso estamos para resolver dudas
ahora una vez mencionados los fundamentos del foro pasemos a lo importante que es tu duda pues yo tengo un una macro que realize la cual te podría ser de utilidad tendrías que modificarla a tu conveniencia te comento lo que hace
en base a una página principal seleccionas una carpeta la cual (en mi caso busca archivos en excel) dentro de esa carpeta muestra todos los archivos, cuando se le da aceptar toma la ruta seleccionada, después en una celda especifica ingresamos el dato a buscar y dentro de esa carpeta y en cada uno de los archivos busca el dato ingresado y muestra en las celdas siguientes el nombre del archivo, la hoja y la celda en la que se encuentra dicho dato. Estoy consiente que no es lo que buscas pero podría ser un inicio de algo te ha de servir mi macro no esta terminada pues no he colocado los hipervínculos para que se abra automáticamente el archivo
pero vuelvo a decirlo de algo te ha de servir enviame un correo y te lo mando con gusto y pues
y pues estoy dispuesto a ayudar si tu estas dispuesto a investigar y no esperar a que te lo hagan es más si entre los dos podemos mejorar mi macro seria genial así los dos ganamos =D
pero bueno espero te sea de utilidad y cualquier duda no dudes en preguntar que para eso estamos para resolver dudas
Respuesta de Luis Gonzalez
1
Que pena no haberte contestado con anterioridad, estuve un poco ocupado. Leí pero no comprendí muy bien tu pregunta; sin embargo aquí te dejo estos datos:
Para ejecutar una macro apenas se abra Excel osea una macro auto ejecutable usas esta instrucción:
Sub auto_open()
msgbox "Hola, prueba macro auto ejecutable"
'si deseas cargar más subrutinas aqui escribes el nombre
End
End sub
De esta manera se carga automáticamente las macros que quieras, funciona bien con Excel 2003/2007.
Ahora para obtener la ruta de cualquier archivo usa la siguiente sub rutina:
Sub ShowFileAccessInfo(filespec)
Dim fs, d, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(filespec)
s = UCase(f.Path) & vbCrLf 'la propiedad Path te muestra la ruta completa de un archivo, por lo cual no sé sí te sirva.
s = s & "Creado: " & f.DateCreated & vbCrLf
s = s & "Último acceso: " & f.DateLastAccessed & vbCrLf
s = s & "Última modificación: " & f.DateLastModified
MsgBox s, 0, "Información de acceso al archivo"
End Sub
Para ejecutar una macro apenas se abra Excel osea una macro auto ejecutable usas esta instrucción:
Sub auto_open()
msgbox "Hola, prueba macro auto ejecutable"
'si deseas cargar más subrutinas aqui escribes el nombre
End
End sub
De esta manera se carga automáticamente las macros que quieras, funciona bien con Excel 2003/2007.
Ahora para obtener la ruta de cualquier archivo usa la siguiente sub rutina:
Sub ShowFileAccessInfo(filespec)
Dim fs, d, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(filespec)
s = UCase(f.Path) & vbCrLf 'la propiedad Path te muestra la ruta completa de un archivo, por lo cual no sé sí te sirva.
s = s & "Creado: " & f.DateCreated & vbCrLf
s = s & "Último acceso: " & f.DateLastAccessed & vbCrLf
s = s & "Última modificación: " & f.DateLastModified
MsgBox s, 0, "Información de acceso al archivo"
End Sub
Respuesta de sir1
1
Fíjate que he visto ese proceso pero en sistemas ya elaborados para esa acción que haces.
Ejemplo:
Cuando se escanean libros, documentos etc. se almacenan las hojas en pdf, siendo muchos pdfs, el sistema ordena de cada libro su tema o capitulo correspondiente, el sistema al final te realiza un listado de los libros que se tienen en pdf, al darle clic al libro te manda al indice de el libro y ahí puedes consultar dicho libro.
Teniendo todo en orden y forma, se copia a un disco. Y así el usuario final puede analizar los archivos como si fueran una biblioteca virtual.
En resumen: vas a tener varias carpetas dentro otras subcarpetas, dentro, archivos pdf's. Y un pdf maestro tendrá el indice de todo!
El sistema se llama... bueno hay uno que se llama BCS-2 y debe haber otro pero desgraciadamente se me olvido
Busca en internet el verbo batch, las referencias son las de digitalización. Igual y tu no digitalizas pero tus pdf los exportas al sistema y el te los ordena por lotes!
Disculpame por no poderte ayudar en excel :(
Ejemplo:
Cuando se escanean libros, documentos etc. se almacenan las hojas en pdf, siendo muchos pdfs, el sistema ordena de cada libro su tema o capitulo correspondiente, el sistema al final te realiza un listado de los libros que se tienen en pdf, al darle clic al libro te manda al indice de el libro y ahí puedes consultar dicho libro.
Teniendo todo en orden y forma, se copia a un disco. Y así el usuario final puede analizar los archivos como si fueran una biblioteca virtual.
En resumen: vas a tener varias carpetas dentro otras subcarpetas, dentro, archivos pdf's. Y un pdf maestro tendrá el indice de todo!
El sistema se llama... bueno hay uno que se llama BCS-2 y debe haber otro pero desgraciadamente se me olvido
Busca en internet el verbo batch, las referencias son las de digitalización. Igual y tu no digitalizas pero tus pdf los exportas al sistema y el te los ordena por lotes!
Disculpame por no poderte ayudar en excel :(
Respuesta de oflodac
-1
Tu pregunta debes dirigirla a expertos en programación:
http://www.todoexpertos.com/categorias/tecnologia-e-internet/software-y-aplicaciones/expertos
Las macros son programación, lo siento
Finaliza y puntea
http://www.todoexpertos.com/categorias/tecnologia-e-internet/software-y-aplicaciones/expertos
Las macros son programación, lo siento
Finaliza y puntea