abrir carpetas

[Koudelka]

Te pego el código que tengo en estos momentos (lo del format lo he dejado, he quitado lo de la carpeta 400)


Public Function RutaCarpeta(NomCarpeta As String) As String
Dim Ruta As String
Dim Digitos(1 To 4) As String

'Guardamos por separado los digitos en el array
For i = 1 To Len(NomCarpeta)
Digitos(i) = Mid(Format(NomCarpeta, "0000"), i, 1)
Next

Ruta = "D:\GENERAL MACRESA\CLIENTES\Presupuestos\" 'del 1000 al 1999\1400-1499\1400-1409\1400

'Si el primer digito del numero pasado como string es un 0, primera carpeta. si es un 1, segunda carpeta
If Digitos(1) = 0 Then
Ruta = Ruta & "del 0001 al 0999\"
Else
Ruta = Ruta & "del 1000 al 1999\"
End If

'Añadimos la carpeta correspondiente al segundo digito
Ruta = Ruta & Digitos(1) & Digitos(2) & "00-" & Digitos(1) & Digitos(2) & "99\"

'Añadimos la carpeta correspondiente al tercer digito
Ruta = Ruta & Digitos(1) & Digitos(2) & Digitos(3) & "0-" & Digitos(1) & Digitos(2) & Digitos(3) & "9\"

'Por ultimo añadimos la carpeta pasada como parametro
Ruta = Ruta & NomCarpeta

'Y se lo devolvemos a la funcion
RutaCarpeta = Ruta
End Function