Comprobar entrega y/o lectura de correo en Outlook 2003

[jomapaca]

Ok, solo por informar a los que hayan leído esto, les comento que he resuelto el problema:

Todo el problema radicaba en el uso correcto de los objetos. Yo estaba un poco confundido con la situación de las propiedades del objeto MailItem. Tratando incorrectamente de usar el método Item del objeto Items como si usara las mismas propiedades que el MailItem. (¿he sido claro? Espero que si).

En fin, todo se resolvió simplemente asignando el objeto MailItem el Item correspondiente mediante el objeto MAPIFolder de Outlook.

Anexo código para quien lo pueda usar:

NOTA IMPORTANTE: DEBEN SER MUY DETALLISTAS AL MIRAR ESTE CODIGO YA QUE CAMBIA PRACTICAMENTE SOLO 2 LINEAS EN EL.

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 sFechaEnt 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
sAsunto = myItems.Item(i).Subject
Set myItem = myFolder.Items(i) 'ESTA ES LA LINEA QUE MARCA EL CAMBIO
If sAsunto = "Entregado: " & sCriterio Then
If myItem Is Nothing Then GoTo Siguiente
sBody = myItems.Item(i).Body
sUsuario = BuscaUsuario(sBody, sCriterio)
sFechaEnt = Format(myItem.ReceivedTime, "dd/mm/yyyy")
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 = ActiveCell.Row
Range("B" & F).Value = sFechaEnt

End If
Siguiente:
Next

End Sub