Exchange Server

Dave Kane [MVP - Outlook] · Guest

Xavier,

If DAV:contentclass = "urn:content-classes:dsn" (indicating that it's a
non-delivery report) then look in urn:schemas:httpmail:displayto and
urn:schemas:httpmail:displaycc for the original recipients. Does that give
you what you need to eliminate addresses from your outgoing mailings?

Dave
"Xavier BETOUX" <XavierBETOUX@discussions.microsoft.com> wrote in message
news:6D67AD63-FB0F-4B80-86CC-EF6694AC4761@microsoft.com...

Xavier BETOUX · Guest

to directly get the original recept, yes;
but i also need to get the smtp code X.Y.zz (4 transient error, 5 permanent
error, ...) to definitively or temporarly delete the recept and that is the
reason i need to read the content of the non delivery report

"Dave Kane [MVP - Outlook]" wrote:

Xavier BETOUX · Guest

Dave, this is the last code tested

then http://schemas.microsoft.com/mapi/proptag/0x1001001E gives a null value
if i did write a good code

Function GetMessages(StrUser As String, StrPwd As String) As Long

Dim Objet As String, Expediteur As String, Corps As String, TypeMedia As
String, Attachement As String
Dim Flag As Boolean

Dim NbRec As Long

Dim I As Long

' Reference to Microsoft ActiveX Data Objects 2.5 Library
' Reference to Microsoft CDO for Exchange 2000 Server Library

' Declare variables.
Dim Rec As New ADODB.Record
Dim Rs As New ADODB.Recordset
Dim strView As String
Dim strURLInbox As String
Dim strURLMailbox As String
Dim Info As New ADSystemInfo
Dim Flds As ADODB.Fields
Dim Fld As ADODB.Field

Dim P As Integer, Z As String

' Build the mailbox URL for the user.
strURLMailbox = "file://./backofficestorage/" + Info.DomainDNSName + "/MBX/"
+ StrUser
' Get the inbox folder for the user's mailbox.
PBar.Visible = False

ErrDevice = 0
On Error GoTo ErrorHandler
Rec.Open strURLMailbox, , , , , StrUser, StrPwd
On Error GoTo 0
If ErrDevice <> 0 Then GetMessages = ErrDevice: MsgErr = "Rec.open " &
strURLMailbox & " " & MsgErr: Exit Function

strURLInbox = Rec.Fields("urn:schemas:httpmail:inbox")

' Close the connection.
Rec.Close

' Open the user's inbox folder.
On Error GoTo ErrorHandler
Rec.Open strURLInbox, Rec.ActiveConnection
On Error GoTo 0
If ErrDevice <> 0 Then GetMessages = ErrDevice: MsgErr = "Rec.open " &
strURLInbox & " " & MsgErr: Exit Function

'Build the search query.
strView = "select " _
& " ""DAV:href""" _
& ", ""DAV:contentclass""" _
& ", ""urn:schemas:httpmail:datereceived""" _
& ", ""DAV:isfolder""" _
& ", ""DAV:getcontentlength""" _
& ", ""urn:schemas:httpmail:from""" _
& ", ""urn:schemas:httpmail:subject""" _
& ", ""urn:schemas:httpmail:displayto""" _
& ", ""urn:schemas:httpmail:hasattachment""" _
& ", ""urn:schemas:httpmail:attachmentfilename""" _
& ", ""urn:schemas:httpmail:read""" _
& ", ""urn:schemas:mailheader:content-description""" _
& ", ""urn:schemas:httpmail:textdescription""" _
& ", ""http://schemas.microsoft.com/mapi/proptag/0x1001001E""" _
& " from scope ('shallow traversal of """ _
& strURLInbox & """') " _
& " WHERE ""DAV:isfolder"" = false AND ""DAV:ishidden"" = false" _
& " ORDER BY ""urn:schemas:httpmail:datereceived"" DESC"

' Open the recordset with the search query.
On Error GoTo ErrorHandler
Rs.Open strView, Rec.ActiveConnection
On Error GoTo 0
If ErrDevice <> 0 Then GetMessages = ErrDevice: MsgErr = "Rs.open " &
strView & " " & MsgErr: Exit Function

' No messages in the inbox.
NbRec = Rs.RecordCount
If NbRec > 0 Then

PBar.Visible = True
PBar.Value = 0
PBar.Max = NbRec
' Open a test file to see part of results
Open "c:\Test.cdo" For Output As 1

' Move to the first message.
Rs.MoveFirst

I = 0
' List the last 50 messages in the inbox.
Do While Not Rs.EOF

PBar.Value = PBar.Value + 1

I = I + 1
If I > 50 Then Exit Do
Objet = ""
Expediteur = ""
Corps = ""
Attachement = ""

Set Flds = Rs.Fields
For Each Fld In Flds
Print #1, "Name="; Fld.Name; "=";
If Not IsNull(Fld.Value) Then Print #1, Fld.Value;
Print #1, vbTab;
Next
Print #1,

Set Fld = Flds("urn:schemas:httpmail:subject")
If Not IsNull(Fld.Value) Then Objet = Fld.Value
Set Fld = Flds("urn:schemas:httpmail:from")
If Not IsNull(Fld.Value) Then Expediteur = Fld.Value
Set Fld = Flds("urn:schemas:httpmail:hasattachment")
If Not IsNull(Fld.Value) Then
If Fld.Value Then
Set Fld = Flds("DAV:contentclass")
If Not IsNull(Fld.Value) Then
Attachement = Fld.Value
Select Case Fld.Value
Case "urn:content-classes:dsn", "urn:content-classes:mdn"
On Error GoTo ErrorHandler
Set Fld =
Flds("http://schemas.microsoft.com/mapi/proptag/0x1001001E")
On Error GoTo 0
If ErrDevice <> 0 Then GetMessages = ErrDevice: MsgErr
= "http://schemas.microsoft.com/mapi/proptag/0x1001001E " & MsgErr: Exit
Function
If Not IsNull(Fld.Value) Then
Attachement = Fld.Value
End If

On Error GoTo ErrorHandler
Set Fld = Flds("urn:schemas:httpmail:displayto")
On Error GoTo 0
If ErrDevice <> 0 Then GetMessages = ErrDevice: MsgErr
= "urn:schemas:httpmail:displayto " & MsgErr: Exit Function
If Not IsNull(Fld.Value) Then Expediteur = Fld.Value

Case Else
Set Fld = Flds("urn:schemas:httpmail:textdescription")
If Not IsNull(Fld.Value) Then Corps = Fld.Value
Set Fld =
Flds("urn:schemas:httpmail:attachmentfilename")
If Not IsNull(Fld.Value) Then Attachement =
Attachement & " " & Fld.Value
End Select
End If
End If
End If

ZMail.AddItem RemTab(Expediteur) & vbTab & RemTab(Objet) & vbTab &
RemTab(Corps) & vbTab & Attachement

Rs.MoveNext
Loop

Close #1

PBar.Visible = False

Else

MsgErr = "No message"

End If
If ZMail.Rows > 1 Then ZMail.FixedRows = 1

' Clean up.
Rec.Close
Rs.Close

Set Rec = Nothing
Set Rs = Nothing
Set Flds = Nothing
Set Fld = Nothing
GetMessages = NbRec
Exit Function
ErrorHandler:

ErrDevice = Err.Number
MsgErr = Err.Description
'Clean up.
Resume Next

End Function

Dave Kane [MVP - Outlook] · Guest

http://schemas.microsoft.com/mapi/proptag/0x1001001E is a property of the
MAPI Recipients object, which is a subobject of the report message. I don't
see a way to get to it via WebDAV but there must be because OWA shows it.
"Xavier BETOUX" <XavierBETOUX@discussions.microsoft.com> wrote in message
news:18A1330C-FBA8-4FF0-BE6A-D4ED4B185856@microsoft.com...

	Exchange Server Forum Index -> Development	All times are GMT Goto page Previous 1, 2
Page 2 of 2