Comprobar entrega y/o lectura de correo en Outlook 2003

[jomapaca]

Que tal!!! Trataré de ser muy explicito en el problema que me aqueja.

Estoy generando una macro en excel que envía correos electrónicos con un archivo adjunto. Este primer proceso ya lo hace. Todo funciona sin problema debido a que todo estos envíos se realizan a usuarios de la misma empresa y no hay mayor problema.

El verdadero problema comienza aqui: Es imprescindible que valide si el usuario recibió y leyó el correo y generar un reporte de esto. Sé que el envío del correo no es garantía de su lectura, pero eso es precisamente lo que tengo que validar.

He activado la confirmación de entrega y lectura mediante el siguiente bloque de codigo:

ElMensaje.Subject = "TARIFICADOR " & mes_año
ElMensaje.BodyFormat = olFormatHTML
ElMensaje.HTMLBody = txtHTML
ElMensaje.Attachments.Add Nombre, 1, 1
ElMensaje.DELETEAFTERSUBMIT = True
ElMensaje.ReadReceiptRequested = True 'Se solicita confirmación de lectura
ElMensaje.OriginatorDeliveryReportRequested = True 'Se origina reporte de entrega
ElMensaje.IMPORTANCE = 2
ElMensaje.send

Esto funciona correctamente. A mi bandeja de entrada llegan los correos que confirman la entrega y la lectura.

Ahora lo que procede es generar ese reporte (un simple listado) en Excel. La primera parte la hago mediante la validación del SUBJECT, uso el método RESTRICT para restringir los correos que concuerden con el subject indicado (una cadena que siempre será la misma, sólo cambia el mes y el año). Tambien funciona correctamente y puedo obtener asunto y cuerpo del mail, sin embargo, no puedo obtener el nombre del usuario al cual se le envió el correo. Me envía un error que me dice "Tipo de datos no coinciden". Me queda claro a que se debe, pero no logro entender como debería hacerlo entonces si se supone que el objeto ITEMS en su método ITEM me permite obtener esto. Anexo el código que describo:


Sub ChecaEntrega()

Dim i As Integer
Dim F As Integer

Dim sAsunto As String
Dim sBody As String
Dim sUsuario As String

Dim sCriterio As String
Dim fecha As String

Dim myOlApp As Outlook.Application
Dim myNamespace As Outlook.Namespace
Dim myFolder As Outlook.MAPIFolder
Dim myLecturas As Outlook.MAPIFolder
Dim myItems As Outlook.Items
Dim myRestrictItems As Outlook.Items
Dim myItem As Outlook.MailItem


fecha = InputBox("Indique mes y año a verificar")
If fecha <> "" Then
sCriterio = "TARIFICADOR " & UCase(fecha)
Else
sCriterio = "TARIFICADOR "
End If

Set myOlApp = CreateObject("Outlook.Application")
Set myNamespace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)

Set myItems = myFolder.Items
Set myRestrictItems = myItems.Restrict("[Subject] = '" & sCriterio & "'")


For i = myRestrictItems.Count To 1 Step -1
myRestrictItems(i).Move myFolder.Folders("Lecturas")
Next

Set myLecturas = myFolder.Folders("Lecturas")


Set myItems = myFolder.Folders("Lecturas").Items

'VERIFICA PRIMERO LA ENTREGA DE LOS CORREOS
For i = myItems.Count To 1 Step -1
Set myItem = myItems.Item(i) 'AQUI SE GENERA EL ERROR
sAsunto = myItems.Item(i).Subject 'PERO ESTO FUNCIONA PERFECTO
If sAsunto = "Entregado: " & sCriterio Then
sBody = myItems.Item(i).Body
'sUsuario = myItems.Item(i)
ActiveWorkbook.Sheets("ENVIADOS").Activate
Columns("A:A").Select
Selection.Find(What:="" & sUsuario & "", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

F = Selection.Row
Range("B" & F).Value = myItem(i).ReceivedTime
End If
Next




End Sub

Agradeceré muchisimo cualquier ayuda que puedan ofrecer. Esto me urge de verdad, me pongo en sus manos.

Gracias de antemano, saludos a todos!