Finding recipients on undeliverable mail

[drepp]

I just got done programming a VBA script for Outlook 2000. Basically, whenever e-mail is sent, it kicks and allows the user to opt to record their e-mail to a database. I'll paste in that code below.

The code works just fine for normal e-mail. However, when the user gets undeliverable mail returned, and attempts to resend it, for whatever reason it's not type olMail--it's now type olReport. So I modified the code to trap type olReport and handle it separately. That change to the code isn't included below, but you get the idea.

Unfortunately, there's a problem. Class olReport is missing the Recipients collection that olMail has. It has everything else, including Body, Attachments, Subject, etc, but not Recipients! Nor does it have To, CC, or BCC properties, even though it's being sent just like any other e-mail.

Does anyone know of a way I can collect the Recipients of an undeliverable mail that's being resent? Or a way I can force the olReport to conform to olMail's setup?

Thanks in advance!


Private Sub application_itemsend(ByVal Item As Object, Cancel As Boolean)

If MsgBox("Do you want to record this e-mail?", vbYesNo) = vbNo Then Exit Sub

Dim objItem As MailItem
Set objItem = Item

Dim Conn As New Connection
Dim RST As New Recordset

Dim TempSTR As String
Dim i As Integer

Conn.ConnectionString = "driver={SQL Server};server=XXX;uid=XXX;pwd=XXX;database=XXX;"
Conn.Open

RST.Open "Select * FROM [EmailLog]", Conn, adOpenDynamic, adLockOptimistic
RST.AddNew

Dim r As Recipient

For Each r In objItem.Recipients

If TypeName(r.AddressEntry.Members) <> &quot;Nothing&quot; Then

For i = 1 To r.AddressEntry.Members.Count

If Left(r.AddressEntry.Members.Item(i).Address, 1) = &quot;/&quot; Then
TempSTR = TempSTR & r.AddressEntry.Members.Item(i).Name & &quot; | &quot;
Else
TempSTR = TempSTR & r.AddressEntry.Members.Item(i).Name & &quot; (&quot; & r.AddressEntry.Members.Item(i).Address & &quot | &quot;
End If

Next i

Else

If Left(r.Address, 1) = &quot;/&quot; Then
TempSTR = TempSTR & r.Name & &quot; | &quot;
Else
TempSTR = TempSTR & r.Name & &quot; (&quot; & r.Address & &quot | &quot;
End If

End If

Next r

If Right(TempSTR, 3) = &quot; | &quot; Then TempSTR = Left(TempSTR, Len(TempSTR) - 3)

RST(&quot;EmailTo&quot = TempSTR
'RST(&quot;EmailCC&quot = objItem.CC
'RST(&quot;EmailBCC&quot = objItem.BCC
RST(&quot;EmailSubject&quot = objItem.Subject
RST(&quot;EmailBody&quot = objItem.Body
RST(&quot;EmailSenderName&quot = objItem.Application.Session.CurrentUser


TempSTR = &quot;&quot;

For i = 1 To objItem.Attachments.Count

TempSTR = TempSTR & objItem.Attachments(i) & &quot; | &quot;

Next i

If Right(TempSTR, 3) = &quot; | &quot; Then TempSTR = Left(TempSTR, Len(TempSTR) - 3)

RST(&quot;EmailAttachments&quot = TempSTR
RST.Update

RST.Close
Set RST = Nothing

Conn.Close
Set Conn = Nothing

End Sub