Error: ".... No tiene el permiso necesario"

Hola hector Miguel

Creo que al menos el objetivo inicial (copiar el adjunto y mover el
mensaje) ya lo he logrado, aunque no estoy nada seguro de si funciona con
varios mensajes (con dos si, pero me dejó un tercero sin mover, aunque
puede ser por el modo de paso a paso por instrucciones que he usado por
primera vez y ahora no se muy bien como quitar). De momento este es el
codigo, en el que he quitado la creacion de la carpeta dando por hecho que
ya esta creada manualmente y, otra de esas cosas "obvias"(creo) de las que
antes te hablaba pero que uno se empeña en mantener, he sacado la
asignacion de la carpeta crpCopiasLib del bucle For next( supongo que por
esto se producia algo parecido a un bucle infinito, usando el 100% de la
cpu ).

Dim OutlookApp As New Outlook.Application
Dim crpEntrada As Outlook.MAPIFolder
Dim indMsj As Outlook.Items
Dim msjMensaje As Outlook.MailItem
Dim adjMensaje As Outlook.Attachment
Dim iIt As Integer
Dim crpCopiaLib As Outlook.MAPIFolder
Set crpEntrada = OutlookApp.GetNamespace("MAPI") _
.GetDefaultFolder(olFolderInbox)
Set indMsj = crpEntrada.Items
Set crpCopiaLib = crpEntrada.Folders("CopiasLibreriaM")
For iIt = 1 To crpEntrada.Items.Count
Set msjMensaje = indMsj.Item(iIt)
With msjMensaje
If Left(.Subject, 18) = "Cambios BIBLIOTECA" Then
Set adjMensaje = .Attachments.Item(1)
adjMensaje.SaveAsFile _
"C:\Documents and Settings\ _
AllUsers\Documentos\BibliotecaM\CopiasACT" & _
"\" & .Subject & ".xls"
.Move crpCopiaLib
End If
End With
Next
OutlookApp.Quit
Set crpCopiaLib = Nothing
Set adjMensaje = Nothing
Set msjMensaje = Nothing
Set indMsj = Nothing
Set crpEntrada = Nothing
Set OutlookApp = Nothing
End Sub

Si te parece oportuno comentarme lo que veas en el codigo, estare
encantado de seguir vampirizando tu sabiduria.

En cualquier caso muchas gracias por todo.

Un saludo y hasta pronto
Ivan

Hola de nuevo, Hector Miguel

Para no faltar a mi (mala) costrumbre de poner ristras de mensajes aqui
mando otro con lo que creo que soluciona el problema planteado en el
anterior: no movia todos los archivos porque -supongo- al ir quitandolos
el nº de mensajes diminuia pero el contador no, con lo que excedia el
indice. Parece solucionarse invirtiendo el contador y usando step - 1:

For iIt = crpEntrada.Items.Count To 1 Step -1

Bueno, espero no tener que volver a molestarte/os con este tema, aunque si
tienes tiempo y todavia te quedan ganas despues de todos estos
soliloquios,
no me importaria escuchar tus consejos sobre adelgazamiento y demas
defectos de los codigos.

Gracias otra vez y un saludo

Ivan

hola, Ivan !

... lo que creo que soluciona el problema planteado en el anterior:
no movia todos los archivos porque -supongo- al ir quitandolos el nº de mensajes diminuia pero el contador no
con lo que excedia el indice. Parece solucionarse invirtiendo el contador y usando step - 1:
For iIt = crpEntrada.Items.Count To 1 Step -1 [...]

veo que el 'descanso' [que me tome] no mermo tu tenacidad, hasta encontrarle 'la cuadratura al circulo'... [enhorabuena] :))

saludos,
hector.

p.d. avisame cuando quieras ingresar al codigo a la 'clinica reductiva' :D

Hola Hector Miguel

Te tomo la palabra y cualquier dia de estos te invado la clinica. Espero
que tengas camas suficientes, pues el nº de pacientes empieza a ser
preocupante.

Un saludo y hasta pronto.
Ivan

PD: sin animo de agotarte, ¿seria muy dificil que todo el proceso con los
mensajes se realizase directamente, de una manera mas o menos
automatica,desde outlook al recibir uno de los mentados adjuntos?. Me
conformo con la mas minima pista.

Lo dicho, un saludo.

hola de nuevo

Como no podia ser menos,un nuevo problema, un nuevo error y, de momento,
una nueva solucion:

Resulta que me acabo de enterar de que existen mensajes de correo que no
son "mensajes de correo", son informes,...y a saber que mas, con lo que el
anterior codigo daba error 13 si se encontraba uno de estos en la b. de
entrada. Al final, y tras volverme loco he descubierto este "pequeño"
detalle de los "no mensajes", y la cosa parece resolverse añadiendo al
codigo esto:

If indMsj(iIt).Class = olMail Then

Y para terminar expongo el codigo resultante por si le es de utilidad a
alguien y, ya de paso, para esa buena cura de adelgazamiento.

Dim OutlookApp As New Outlook.Application
Dim crpEntrada As Outlook.MAPIFolder
Dim indMsj As Outlook.Items
Dim msjMensaje As Outlook.MailItem
Dim adjMensaje As Outlook.Attachment
Dim iIt As Integer, iCont As Integer
Dim crpCopiaLib As Outlook.MAPIFolder
Set crpEntrada = OutlookApp.GetNamespace("MAPI") _
.GetDefaultFolder(olFolderInbox)
Set indMsj = crpEntrada.Items
Set crpCopiaLib = crpEntrada.Folders("CopiasLibreriaM")
' recorre los elementos recibidos en la bandeja de entrada
For iIt = indMsj.Count To 1 Step -1 'iCont
' si el elemento es de la clase "mensaje"
If indMsj(iIt).Class = olMail Then
' crea el objeto mensaje
Set msjMensaje = indMsj.Item(iIt)
With msjMensaje
' si el asunto del mensaje comienza por "Cambios BIBL"
If Left(.Subject, 12) = "Cambios BIBL" Then
' crea el objeto adjunto
Set adjMensaje = .Attachments.Item(1)
' guarda el adjunto en... y como.
adjMensaje.SaveAsFile _
"C:\Documents and Settings\All Users\Documentos\" & _
"BibliotecaM\CopiasACT" & "\" & .Subject & ".xls"
' mueve el mensaje a una subcarpeta de la de entrada
.Move crpCopiaLib
End If
End With
End If
Next
OutlookApp.Quit
Set crpCopiaLib = Nothing
Set adjMensaje = Nothing
Set msjMensaje = Nothing
Set indMsj = Nothing
Set crpEntrada = Nothing
Set OutlookApp = Nothing
End Sub


Un saludo y hasta pronto
ivan