obtener un directorio

no sé como requieres la informacion, pero sin usar excel y desde la linea de
comandos (CMD), te posicionas en el directorio raiz y escribes lo siguiente:

Dir /s >Arbol.txt

esta instruccion te guarda todas las carpetas, subcarpetas y archivos que
hay en cada carpeta en un archivo de texto llamado Arbol.txt

Saludos!

"Rudolph" escribió en el mensaje
news:

saludos grupo

como podria leer un subdirectorio, extraer de alli los nombres de todos
los
archivos que lo componen y escribir los nombres en una hoja de excel.
ej.
1.- dir e:odolfo\
2.- alfa.xls, beta.xls, gama.xls, pi.xls, etc.xls
3.- estos nombres quiero copiarlos en una columna de una hoja de calculo.

A
1 alfa.xls
2 beta.xls
3 gama.xls
4 pi.xls
5 etc.xls

gracias



Rodolfo Rangel
Corpivensa
S.G.

gracias mauro...

esa me la se...:(

quisiera hacerlo desde excel porque esto forma parte de otro proceso
(codigo) que lee esa lista y hace otros calculos
Rodolfo Rangel
Corpivensa
S.G.


"Mauro Jesús" wrote:

no sé como requieres la informacion, pero sin usar excel y desde la linea de
comandos (CMD), te posicionas en el directorio raiz y escribes lo siguiente:

Dir /s >Arbol.txt

esta instruccion te guarda todas las carpetas, subcarpetas y archivos que
hay en cada carpeta en un archivo de texto llamado Arbol.txt

Saludos!

"Rudolph" escribió en el mensaje
news:
> saludos grupo
>
> como podria leer un subdirectorio, extraer de alli los nombres de todos
> los
> archivos que lo componen y escribir los nombres en una hoja de excel.
> ej.
> 1.- dir e:odolfo\
> 2.- alfa.xls, beta.xls, gama.xls, pi.xls, etc.xls
> 3.- estos nombres quiero copiarlos en una columna de una hoja de calculo.
>
> A
> 1 alfa.xls
> 2 beta.xls
> 3 gama.xls
> 4 pi.xls
> 5 etc.xls
>
> gracias
>
>
>
> Rodolfo Rangel
> Corpivensa
> S.G.
>

"Rudolph" escribió

saludos grupo

como podria leer un subdirectorio, extraer de alli los nombres de todos
los
archivos que lo componen y escribir los nombres en una hoja de excel.
ej.
1.- dir e:odolfo\
2.- alfa.xls, beta.xls, gama.xls, pi.xls, etc.xls
3.- estos nombres quiero copiarlos en una columna de una hoja de calculo.

A
1 alfa.xls
2 beta.xls
3 gama.xls
4 pi.xls
5 etc.xls

gracias



Rodolfo Rangel
Corpivensa
S.G.

Hola Rodolfo,

Te paso tres formas,

1) El siguiente procedimiento. Modifica la ruta según tus necesidades.
Revisa la ayuda de la función Dir.

Sub ListaDir()
Dim i As Long
Dim MiRuta As String
Dim MiNombre As String

i = 1
MiRuta = "c:\temp\*.xls"
MiNombre = Dir(MiRuta, 0)
Do While MiNombre <> ""
If MiNombre <> "." And MiNombre <> ".." Then
Range("E" & i) = MiNombre
i = i + 1
End If
MiNombre = Dir
Loop

End Sub

2) El método propuesto en la siguiente página
http://www.erlandsendata.no/english...infolder97

3) Mediante las antiguas Excel 4 macro. descrito en la siguiente página
http://www.jkp-ads.com/Articles/ExcelNames08.htm

resumido
Crea un nombre Archivo con la siguiente fórmula
=Archivos($C$1)

En C1 pon la ruta con la ruta con la extensión que quieras
=c:\temp\*.xls

en A1 escribe la siguiente fórmula
=INDICE(Archivo;FILA())

y arrastra hasta que aparezca un error #¡REF! que será cuando se acaben los
archivos.

Un saludo,
Juan

Que tal Rodolfo.. checate esto en codigo VB normal y comentas

Option Explicit

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Public wksH As Worksheet
Public lngContFila As Long

Private Function GetDirectory(Optional Mensaje As String) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer

'Directorio raíz (escritorio)
bInfo.pidlRoot = 0&

'Título para el diálogo
If IsMissing(Mensaje) Then
bInfo.lpszTitle = "Seleccionar un directorio"
Else
bInfo.lpszTitle = Mensaje
End If

'Tipo del directorio a devolver
bInfo.ulFlags = &H1

'Presentar el diálogo
x = SHBrowseForFolder(bInfo)

'Analizar el resultado
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function


Sub ListarFicheros()
Set wksH = Worksheets("Hoja1") 'Hoja donde se mostrarán los ficheros

Dim fso As Object, fCarpeta As Object, tmpCarpeta As Object
Dim Fichero As Object, tmpFichero As Object
Dim strRutaInicial As String

strRutaInicial = GetDirectory("Seleccionar el directorio a partir del
cual comenzará el listado.")
If strRutaInicial = "" Then Exit Sub

Set fso = CreateObject("Scripting.FileSystemObject")
Set fCarpeta = fso.GetFolder(strRutaInicial)

wksH.Range("A1") = "Ruta"
wksH.Range("B1") = "Nombre"
wksH.Range("C1") = "Tamaño"
wksH.Range("D1") = "Fecha Modif."
wksH.Range("E1") = "Nombre largo"

lngContFila = 2

Application.ScreenUpdating = False

For Each tmpFichero In fCarpeta.Files

wksH.Cells(lngContFila, 1) = fCarpeta.path
wksH.Cells(lngContFila, 2) = tmpFichero.Name
wksH.Cells(lngContFila, 3) = tmpFichero.Size
wksH.Cells(lngContFila, 4) = tmpFichero.DateLastModified
wksH.Cells(lngContFila, 5) = tmpFichero.ShortName

lngContFila = lngContFila + 1
If lngContFila > 65535 Then
MsgBox prompt:="Demasiados ficheros.", Buttons:=vbCritical +
vbOKOnly, Title:="EscribirEnArchivos"
Exit Sub
End If

Next tmpFichero

Set tmpFichero = Nothing
Set Fichero = Nothing
Set tmpCarpeta = Nothing
Set fCarpeta = Nothing
Set fso = Nothing

EscribirArchivos2 strRutaInicial

With wksH
.Range("A1:E1").HorizontalAlignment = xlCenter
.Range("A1:E1").Font.Bold = True
.Cells(lngContFila, 3).Formula = "=SUM(C2:B" & lngContFila - 1 & ")"
.Range("C2:C" & lngContFila).NumberFormat = "#,##0"
.Range("D2:D" & lngContFila).NumberFormat = "dd-mm-yy hh:mm:ss"
End With

Application.ScreenUpdating = True

wksH.Columns("A:E").AutoFit

Set wksH = Nothing
End Sub

Private Sub EscribirArchivos2(RutaInicial As String)

On Error GoTo ManejoErrores

Dim fso As Object, fCarpeta As Object, tmpCarpeta As Object
Dim Fichero As Object, tmpFichero As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set fCarpeta = fso.GetFolder(RutaInicial)

For Each tmpCarpeta In fCarpeta.SubFolders
For Each tmpFichero In tmpCarpeta.Files

wksH.Cells(lngContFila, 1) = tmpCarpeta.path
wksH.Cells(lngContFila, 2) = tmpFichero.ShortName
wksH.Cells(lngContFila, 3) = tmpFichero.Size
wksH.Cells(lngContFila, 4) = tmpFichero.DateLastModified
wksH.Cells(lngContFila, 5) = tmpFichero.Name

lngContFila = lngContFila + 1
If lngContFila > 65535 Then
Application.ScreenUpdating = True
MsgBox prompt:="Demasiados ficheros.", Buttons:=vbCritical +
vbOKOnly, Title:="EscribirEnArchivos"
Exit Sub
End If

Next

EscribirArchivos2 tmpCarpeta.path

Next

Set tmpFichero = Nothing
Set Fichero = Nothing
Set tmpCarpeta = Nothing
Set fCarpeta = Nothing
Set fso = Nothing

Exit Sub

ManejoErrores:
'En Windows XP, algunos ficheros del sistema (como el de paginación)
carecen de nombre corto, por lo que hay que capturar el error que se produce
al intentar acceder a él (propiedad ShortName).
If Err.Number = 5 Then Resume Next Else MsgBox Err.Number &
Err.Description

End Sub


Jesús Peralta
el_ultimo_profeta"alt+64"hotmail.com
Hermosillo, Sonora. Mexico
"Rudolph" escribió en el mensaje
news:

saludos grupo

como podria leer un subdirectorio, extraer de alli los nombres de todos
los
archivos que lo componen y escribir los nombres en una hoja de excel.
ej.
1.- dir e:odolfo\
2.- alfa.xls, beta.xls, gama.xls, pi.xls, etc.xls
3.- estos nombres quiero copiarlos en una columna de una hoja de calculo.

A
1 alfa.xls
2 beta.xls
3 gama.xls
4 pi.xls
5 etc.xls

gracias



Rodolfo Rangel
Corpivensa
S.G.