ir a una carpeta

Creo que el siguiente código hace lo que necesitas, pero ten en cuenta que tiene que examinar el árbol de directorios completo de todas las unidades fijas y de red (hasta que encuentre la carpeta "vacas"), lo que puede llevarle una buena cantidad de tiempo (estoy hablando de varios minutos):


Dim strRutaVacas As String

Sub prueba()
Dim FSO As Scripting.FileSystemObject
Dim DR As Scripting.Drive
Dim fCarpeta As Scripting.Folder
Dim tmpCarpeta As Scripting.Folder
Dim strRutaInicial As String

Set FSO = New Scripting.FileSystemObject

For Each DR In FSO.Drives
If DR.DriveType = Fixed Or DR.DriveType = Remote Then 'Sólo se procesarán las unidades fijas y de red
strRutaInicial = DR.Path & Application.PathSeparator
Set fCarpeta = FSO.GetFolder(strRutaInicial)
Recursivo strRutaInicial
If strRutaVacas <> "" Then Exit For
End If
Next DR

MsgBox strRutaVacas 'La variable strRutaVacas tendrá ahora la ruta al directorio "vacas"

Set tmpCarpeta = Nothing
Set fCarpeta = Nothing
Set DR = Nothing
Set FSO = Nothing
End Sub


Private Sub Recursivo(ByVal RutaInicial As String)
Dim FSO As Scripting.FileSystemObject
Dim fCarpeta As Scripting.Folder
Dim tmpCarpeta As Scripting.Folder

Set FSO = New Scripting.FileSystemObject
Set fCarpeta = FSO.GetFolder(RutaInicial)

For Each tmpCarpeta In fCarpeta.SubFolders
If UCase(tmpCarpeta.Name) = UCase("vacas") Then
strRutaVacas = tmpCarpeta.Path
Exit Sub
End If
Recursivo tmpCarpeta.Path
Next

Set tmpCarpeta = Nothing
Set fCarpeta = Nothing
Set FSO = Nothing

Exit Sub
End Sub


Para que funcione, es necesario que establezcas una referencia a la librería "Microsoft Scripting Runtime". Esto se hace desde Herramientas > Referencias, estando en el editor de VBA.
Un saludo.


Fernando Arroyo
MS MVP - Excel
www.excelesp.com


"fredy" escribió en el mensaje news:

hola grupo!

tengo la siguiente situacion

un archivo com macros que me guarda copias en una carpeta c:\vacas necesito
utilizar este erchivo en otros computadores donde la carpeta vacas no siempre
esta en c:\ puede estar en cualquier otro directorio, como puedo hacer para
que la macro me enrute al directorio vacas sin decirle en que raiz se
encuentra o en que subdirectorio se encuentra,; lo que es seguro es que el
directorio vacas es unico en el pc

muchas gracias!

hola Fernando, muchas gracias por tu atencion solo que al ejecutarlo
sale un error " se ha producido el error 70 en tiempo de ejecucion
permiso denegado" y al depurar seña la linea
"For Each tmpCarpeta In fCarpeta.SubFolders" que podra ser
tengo ya establecida la referencia a Microsoft Scripting Runtime
muchas gracias!

Hola Fredy,

Añade la siguiente linea al principio del macro despues de declarar las
variables:

On Error Resume Next

Saludos,
KL

"fredy" wrote in message
news:
hola Fernando, muchas gracias por tu atencion solo que al ejecutarlo
sale un error " se ha producido el error 70 en tiempo de ejecucion
permiso denegado" y al depurar seña la linea
"For Each tmpCarpeta In fCarpeta.SubFolders" que podra ser
tengo ya establecida la referencia a Microsoft Scripting Runtime
muchas gracias!

El problema puede ser que el código está intentando acceder a las carpetas ocultas y/o del sistema. Prueba con:

Dim strRutaVacas As String

Sub prueba()
Dim FSO As Scripting.FileSystemObject
Dim DR As Scripting.Drive
Dim fCarpeta As Scripting.Folder
Dim tmpCarpeta As Scripting.Folder
Dim strRutaInicial As String

Set FSO = New Scripting.FileSystemObject

For Each DR In FSO.Drives
'If DR.DriveType = Fixed Or DR.DriveType = Remote Then 'Sólo se procesarán las unidades fijas y de red
If DR.DriveType = Fixed Then 'Sólo se procesarán las unidades fijas y de red
strRutaInicial = DR.Path & Application.PathSeparator
Set fCarpeta = FSO.GetFolder(strRutaInicial)
Recursivo strRutaInicial
If strRutaVacas <> "" Then Exit For
End If
Next DR

MsgBox strRutaVacas 'La variable strRutaVacas tendrá ahora la ruta al directorio "vacas"

Set tmpCarpeta = Nothing
Set fCarpeta = Nothing
Set DR = Nothing
Set FSO = Nothing
End Sub


Private Sub Recursivo(ByVal RutaInicial As String)
Dim FSO As Scripting.FileSystemObject
Dim fCarpeta As Scripting.Folder
Dim tmpCarpeta As Scripting.Folder

Set FSO = New Scripting.FileSystemObject
Set fCarpeta = FSO.GetFolder(RutaInicial)

If fCarpeta.Attributes <= 16 Or fCarpeta.Attributes = 54 Then 'No procesará los directorios ocultos y/o del sistema
For Each tmpCarpeta In fCarpeta.SubFolders
If UCase(tmpCarpeta.Name) = UCase("vacas") Then
strRutaVacas = tmpCarpeta.Path
Exit Sub
End If
Recursivo tmpCarpeta.Path
Next
End If

Set tmpCarpeta = Nothing
Set fCarpeta = Nothing
Set FSO = Nothing

Exit Sub
End Sub


Un saludo.


Fernando Arroyo
MS MVP - Excel


"fredy" escribió en el mensaje news:
hola Fernando, muchas gracias por tu atencion solo que al ejecutarlo
sale un error " se ha producido el error 70 en tiempo de ejecucion
permiso denegado" y al depurar seña la linea
"For Each tmpCarpeta In fCarpeta.SubFolders" que podra ser
tengo ya establecida la referencia a Microsoft Scripting Runtime
muchas gracias!