Archivar documentos word en carpetas desde excel

Ahora que tengo un ratito libre estoy probando el codigo pero me da error 13 de no concidir tipos »
Cliente = Evaluate("index(documentos," & n & ")")
Codigo = Evaluate("left(index(documentos," & n & "),8)")
si la ejecutas una vez da error en la linea Cliente = evaluate etc..
Si restableces el error y la vuelves a ejecutar »
funciona :-) perfectamente

lo he probado con rutas como nos explicaba Jose »
carpetas » [ ocho digitos-nombre completo direccion codigo y sin acentos :-P ]
y los archivos » [ mismos ocho digitos-nombre completo ]
Pero esto estoy mirando a ver si puedo modificarla :-) !!
[ y no sabia yo que se podia interactuar asi con los nombres definidos :-)

prueba poniendo una marca de comentario a la linea final del codigo (donde se borran los nombres)
de: Names("subcarpetas").Delete: Names("documentos").Delete
a: ' Names("subcarpetas").Delete: Names("documentos").Delete
y revisa en el libro de prueba si puedes usar en dos celdas una llamada a los nombres:
=subcarpetas
=documentos
y compruebas si los nombres quedaron con los elementos encontrados: {F2}+{F9} (luego de revisar pulsas {esc})

creo que es mas rapido usar funciones de hoja de calculo como indice(... y coincidir(... sobre matrices/nombres en excel
que hacer bucles repetitivos para encontrar (si existe) la posicion de algun elemento buscado sobre matrices de vba :D

hola, Jose !

1) El motivo de el nombre largo de las carpetas es poque necesito que
figuren:
el codigo: 71012123
el nombre: Adrian Pérez Rubio
la población: 46520 Canals (Valencia)
Agente : E42
Son "necesidades" de datos para el trabajo de muchas personas.

con estos "requerimientos" para el nombre de la carpeta... veo
(medio)dificil "cumplirte" con esta parte de tu solicitud inicial:
"... cuando la subcarpeta no exitiera la creara con el mismo nombre del
documento word y archivara ese documento dentro tambien."
"... con tratamiento de errores? ... eso seria ya lo maximo)"

2) Los codigos de clientes son siempre UNICOS no se pueden repetir...
3) ... las carpetas ya existen... se trata de archivar dentro de ellas el
documento word (por cierto son 325 documentos no 825 ni 865)

la siguiente macro (obviamente) no esta probada bajo las condiciones
"reales" de tu situacion tan especial :))
es para trabajarse desde excel (version MINIMA: 2000) te sugiero hacer
prueba/s sobre datos COPIA (solo por si las dudas) y...
si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

Option Base 1
Sub Mover_RTF()
Dim Base As String, sFolder As Object, sFolders(), n As Integer, x As
Integer, _
Cliente As String, Codigo As String, Cambio As String, Nueva As
String
Base = "c:\documents and settings\josé rafael\mis documentos\archivo
general de clientes\"
With CreateObject("scripting.filesystemobject").GetFolder(Base)
ReDim sFolders(.SubFolders.Count)
For Each sFolder In .SubFolders
n = n + 1: sFolders(n) = sFolder.Name: Next: End With
Names.Add "SubCarpetas", Join(sFolders, ",")
Names.Add "SubCarpetas", Split(Evaluate(Names("subcarpetas").RefersTo),
",")
Names.Add "Documentos", "=files(""" & Base & "*.rtf"")": Erase sFolders
For n = 1 To Evaluate("counta(documentos)")
Cliente = Evaluate("index(documentos," & n & ")")
Codigo = Evaluate("left(index(documentos," & n & "),8)")
On Error Resume Next
x = Evaluate("match(""" & Codigo & """,left(subcarpetas,8),0)")
On Error GoTo 0
If x Then
Cambio = Base & Evaluate("index(subcarpetas," & x & ")") & "\"
Else
Nueva = Base & Left(Cliente, Len(Cliente) - 4)
MkDir Base & Nueva
Cambio = Base & Nueva & "\"
End If
Name Base & Ciente As Cambio & Cliente
Next
Names("subcarpetas").Delete: Names("documentos").Delete
End Sub

Hola, buenas tardes:
Lo siento Héctor, no me funciona el código y no he podido averiguar porqué.
Se detiene en la linea:
Names.add "Subcarpetas", Join(sfolders,",")
el error es:
Se ha producido el error 1004 en tiempo de ejecución:
Error definido por la aplicación o el objeto
Lo que he hecho es en un modulo normal del libro pegar tu código
rectificando la palabra ciente por cliente como me advertiste.
¿que debo hacer ahora?
saludos y gracias
José Rafael

... no me funciona el codigo y no he podido averiguar porque. Se detiene en la linea:
Names.add "Subcarpetas", Join(sfolders,",")
el error es: Se ha producido el error 1004 en tiempo de ejecucion: Error definido por la aplicacion o el objeto
Lo que he hecho es en un modulo normal del libro pegar tu codigo rectificando la palabra ciente por cliente como me advertiste.
que debo hacer ahora?

1) El motivo de el nombre largo de las carpetas es poque necesito que figuren:
el codigo: 71012123
el nombre: Adrian Pérez Rubio
la población: 46520 Canals (Valencia)
Agente : E42
Son "necesidades" de datos para el trabajo de muchas personas.

con estos "requerimientos" para el nombre de la carpeta... veo (medio)dificil "cumplirte" con esta parte de tu solicitud inicial:
"... cuando la subcarpeta no exitiera la creara con el mismo nombre del documento word y archivara ese documento dentro tambien."
"... con tratamiento de errores? ... eso seria ya lo maximo)"

2) Los codigos de clientes son siempre UNICOS no se pueden repetir...
3) ... las carpetas ya existen... se trata de archivar dentro de ellas el documento word (por cierto son 325 documentos no 825 ni 865)

la siguiente macro (obviamente) no esta probada bajo las condiciones "reales" de tu situacion tan especial :))
es para trabajarse desde excel (version MINIMA: 2000) te sugiero hacer prueba/s sobre datos COPIA (solo por si las dudas) y...
si cualquier duda (o informacion adicional)... comentas ?

Option Base 1
Sub Mover_RTF()
Dim Base As String, sFolder As Object, sFolders(), n As Integer, x As Integer, _
Cliente As String, Codigo As String, Cambio As String, Nueva As String
Base = "c:\documents and settings\josé rafael\mis documentos\archivo general de clientes\"
With CreateObject("scripting.filesystemobject").GetFolder(Base)
ReDim sFolders(.SubFolders.Count)
For Each sFolder In .SubFolders
n = n + 1: sFolders(n) = sFolder.Name: Next: End With
Names.Add "SubCarpetas", Join(sFolders, ",")
Names.Add "SubCarpetas", Split(Evaluate(Names("subcarpetas").RefersTo), ",")
Names.Add "Documentos", "=files(""" & Base & "*.rtf"")": Erase sFolders
For n = 1 To Evaluate("counta(documentos)")
Cliente = Evaluate("index(documentos," & n & ")")
Codigo = Evaluate("left(index(documentos," & n & "),8)")
On Error Resume Next
x = Evaluate("match(""" & Codigo & """,left(subcarpetas,8),0)")
On Error GoTo 0
If x Then
Cambio = Base & Evaluate("index(subcarpetas," & x & ")") & "\"
Else
Nueva = Base & Left(Cliente, Len(Cliente) - 4)
MkDir Base & Nueva
Cambio = Base & Nueva & "\"
End If
Name Base & Cliente As Cambio & Cliente
Next
Names("subcarpetas").Delete: Names("documentos").Delete
End Sub