Dear all,
I am currently working on VBA programming to check the read status of previously sent emails. I have set .ReadReceiptRequested = True in sending emails but I have problems in checking the reading status. This is due to the object property error when searching through the inbox folder.(Read receipt reports are not the same as mail.items) Can somebody help to extract the SenderName from Read receipt Report?? Thanks in Advance.
Max
from Hong Kong
Here is my code for reference:
Sub CheckReadStatus()
Dim ProjectName As String
ProjectName = "#263"
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim msg As Outlook.MailItem
Dim olMail As Outlook.ReportItem
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Dim rngstart As Range
Dim rngend As Range
Dim rng As Range
Dim strStart As String
Cells(ActiveCell.Row, 1).Select
Do Until ActiveCell.Value = "sent" Or Cells(4, ActiveCell.Column).Value = "End of Distribution List"
If Not ActiveCell.Value = "sent" Then
ActiveCell.Offset(0, 1).Select
End If
Loop
On Error GoTo 0
If Cells(4, ActiveCell.Column).Value = "End of Distribution List" Then
Dim MBerror As String
MBerror = MsgBox("There is no sent notification(s) on list so I can't check status!", _
vbError + vbOKOnly, "Error")
Exit Sub
End If
Set rngstart = ActiveCell
'this is to find out the first person sent in the distribution list
Do Until Cells(4, ActiveCell.Column).Value = "End of Distribution List"
ActiveCell.Offset(0, 1).Select
Loop
On Error GoTo 0
Set rngend = ActiveCell
For Each rng In Range(rngstart, rngend)
If rng.Value = "sent" Then
strStart = Cells(5, rng.Column).Value 'parse cell content to a String
For Each olMail In Fldr.Items
If InStr(olMail.Subject, "Read: " & ProjectName & " New circulation - Ref: " & _
Cells(ActiveCell.Row, 2).Text & _
Cells(ActiveCell.Row, 3).Text & _
Cells(ActiveCell.Row, 4).Text & _
Cells(ActiveCell.Row, 5).Text) > 0 And olMail.SenderName = strStart Then
Dim MBread As String
MBread = MsgBox(strStart & " has read the notification Ref: " & _
Cells(ActiveCell.Row, 2).Text & _
Cells(ActiveCell.Row, 3).Text & _
Cells(ActiveCell.Row, 4).Text & _
Cells(ActiveCell.Row, 5).Text, vbInformation + vbOKOnly)
rng.Value = "read"
End If
Next olMail
End If
Next rng
On Error GoTo 0
Set Fldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
rngstart.Select
Dim MBend As String
MBend = MsgBox("Check finished!", vbInformation + vbOKOnly)
End Sub
I am currently working on VBA programming to check the read status of previously sent emails. I have set .ReadReceiptRequested = True in sending emails but I have problems in checking the reading status. This is due to the object property error when searching through the inbox folder.(Read receipt reports are not the same as mail.items) Can somebody help to extract the SenderName from Read receipt Report?? Thanks in Advance.
Max
from Hong Kong
Here is my code for reference:
Sub CheckReadStatus()
Dim ProjectName As String
ProjectName = "#263"
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim msg As Outlook.MailItem
Dim olMail As Outlook.ReportItem
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Dim rngstart As Range
Dim rngend As Range
Dim rng As Range
Dim strStart As String
Cells(ActiveCell.Row, 1).Select
Do Until ActiveCell.Value = "sent" Or Cells(4, ActiveCell.Column).Value = "End of Distribution List"
If Not ActiveCell.Value = "sent" Then
ActiveCell.Offset(0, 1).Select
End If
Loop
On Error GoTo 0
If Cells(4, ActiveCell.Column).Value = "End of Distribution List" Then
Dim MBerror As String
MBerror = MsgBox("There is no sent notification(s) on list so I can't check status!", _
vbError + vbOKOnly, "Error")
Exit Sub
End If
Set rngstart = ActiveCell
'this is to find out the first person sent in the distribution list
Do Until Cells(4, ActiveCell.Column).Value = "End of Distribution List"
ActiveCell.Offset(0, 1).Select
Loop
On Error GoTo 0
Set rngend = ActiveCell
For Each rng In Range(rngstart, rngend)
If rng.Value = "sent" Then
strStart = Cells(5, rng.Column).Value 'parse cell content to a String
For Each olMail In Fldr.Items
If InStr(olMail.Subject, "Read: " & ProjectName & " New circulation - Ref: " & _
Cells(ActiveCell.Row, 2).Text & _
Cells(ActiveCell.Row, 3).Text & _
Cells(ActiveCell.Row, 4).Text & _
Cells(ActiveCell.Row, 5).Text) > 0 And olMail.SenderName = strStart Then
Dim MBread As String
MBread = MsgBox(strStart & " has read the notification Ref: " & _
Cells(ActiveCell.Row, 2).Text & _
Cells(ActiveCell.Row, 3).Text & _
Cells(ActiveCell.Row, 4).Text & _
Cells(ActiveCell.Row, 5).Text, vbInformation + vbOKOnly)
rng.Value = "read"
End If
Next olMail
End If
Next rng
On Error GoTo 0
Set Fldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
rngstart.Select
Dim MBend As String
MBend = MsgBox("Check finished!", vbInformation + vbOKOnly)
End Sub