abrir carpetas

[Taribo007]

Cambia la funcion por esta:

'************************************************* ***
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(NomCarpeta, i, 1)
Next

Ruta = "D:\GENERAL EMPRESA\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
'************************************************* *******

Se me habian olvidado los guiones

Un saludo