Urgent - Access message body from ado recordset?
Exchange Server Forum Index Exchange Server
Discussion forums for Microsoft Exchange Server users.
Microsoft Outlook
 
 FAQFAQ   MemberlistMemberlist     RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 
 
Google
 
Web ExchangeServerHelp.com
Urgent - Access message body from ado recordset?
Goto page 1, 2  Next
 
Post new topic   Reply to topic    Exchange Server Forum Index -> Development
Author Message
Brett
Guest





Posted: Thu Dec 01, 2005 1:59 am    Post subject: Urgent - Access message body from ado recordset? Reply with quote

I'm using the below code to access a collection of messages in a
particular mailbox / folder. I can see how to access many fields, but I
can't see how to access the actual message contents (body). Using
exchange
explorer, it doesn't show a field which seems to contain the actual
message body. I need to pass it to "getuserinfo" to parse it out with a
regular expression.

Do I have to use CDO for this? How? Below is my code:
'***********************************************************************************************************
Dim objFSO, f1

Set objFSO = Createobject("Scripting.FileSystemObject")
Set f1 = objFSO.CreateTextFile("d:\scripts\exchange\evlog.txt", True)

Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Conn.Provider = "ExOLEDB.DataSource"
Conn.Open "file:\\.\backofficestorage\mailboxlocation"
Dim strQ, url, rs, rsrecord
Dim objRegExpr, retStr, MatchesI, Match
Set objRegExpr = New RegExp
objRegExpr.Global = True
objRegExpr.IgnoreCase = True

URL = "file:\\.\backofficestorage\mailboxlocation"

strQ = ""
strQ = "select "
strQ = strQ & " ""urn:schemas:mailheader:date"""
strQ = strQ & ", ""urn:schemas:httpmail:to"""
strQ = strQ & ", ""urn:schemas:httpmail:from"""
strQ = strQ & ", ""urn:schemas:mailheader:subject"""
strQ = strQ & ", ""urn:schemas:mailheader:received"""
strQ = strQ & ", ""DAV:contentclass"""
strQ = strQ & ", ""DAV:displayname"""
strQ = strQ & ", ""DAV:href"""
strQ = strQ & " from scope ('shallow traversal of "
strQ = strQ & Chr(34) & "" & URL & Chr(34) & "') "
strQ = strQ & " WHERE ""DAV:ishidden"" = False"
f1.Writeline(strQ & vbCrLf)
rs.Open strQ, Conn

f1.Writeline("Error Number: " & Err.Number & vbcrlf)
Err.Clear
rs.movefirst
objRegExpr.Pattern = "mypattern"
Do until rs.EOF
Err.Clear
'f1.Writeline(rs.Fields("DAV:displayname") & vbcrlf )
f1.Writeline("Received: " &
rs.Fields("urn:schemas:mailheader:received") & vbcrlf)
f1.Writeline("Date: " &
rs.Fields("urn:schemas:mailheader:date") &
vbcrlf)
f1.Writeline("DisplayName: " & rs.Fields("DAV:displayname") &
vbcrlf)
f1.Writeline("Subject: " &
rs.Fields("urn:schemas:mailheader:subject") & vbcrlf)
getUserInfo(rs.Fields("urn:schemas:mailheader:subject"))
rs.MoveNext
Loop

Function getUserInfo(strSubject)
If strSubject <> "" Then
f1.Writeline("strSubject: " & strSubject & vbcrlf)
If objRegExpr.Test(strSubject) Then
Set Matches = objRegExpr.Execute(strSubject) '
Execute search.

For Each Match in Matches ' Iterate Matches
collection.
f1.Writeline("Match Value: " & Match.Value &
vbcrlf)
f1.Writeline("Match Index: " & Match.FirstIndex
& vbcrlf)
f1.Writeline("Matches Count: " & Matches.Count)
Next
Else
End If
End Function

f1.Close
Set objFSO = Nothing
rs.Close
Set rs = Nothing
'**********************************************************************************************
any help would be greatly appreciated.

Back to top
Dave Kane [MVP - Outlook]
Guest





Posted: Thu Dec 01, 2005 1:59 am    Post subject: Re: Urgent - Access message body from ado recordset? Reply with quote

Have you tried to get 'urn:schemas:httpmail:textdescription' and/or
'urn:schemas:httpmail:htmldescription'?

"Brett" <brett.mack@gmail.com> wrote in message
news:1133386230.766091.240890@f14g2000cwb.googlegroups.com...
Quote:
I'm using the below code to access a collection of messages in a
particular mailbox / folder. I can see how to access many fields, but I
can't see how to access the actual message contents (body). Using
exchange
explorer, it doesn't show a field which seems to contain the actual
message body. I need to pass it to "getuserinfo" to parse it out with a
regular expression.

Do I have to use CDO for this? How? Below is my code:
'***********************************************************************************************************
Dim objFSO, f1

Set objFSO = Createobject("Scripting.FileSystemObject")
Set f1 = objFSO.CreateTextFile("d:\scripts\exchange\evlog.txt", True)

Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Conn.Provider = "ExOLEDB.DataSource"
Conn.Open "file:\\.\backofficestorage\mailboxlocation"
Dim strQ, url, rs, rsrecord
Dim objRegExpr, retStr, MatchesI, Match
Set objRegExpr = New RegExp
objRegExpr.Global = True
objRegExpr.IgnoreCase = True

URL = "file:\\.\backofficestorage\mailboxlocation"

strQ = ""
strQ = "select "
strQ = strQ & " ""urn:schemas:mailheader:date"""
strQ = strQ & ", ""urn:schemas:httpmail:to"""
strQ = strQ & ", ""urn:schemas:httpmail:from"""
strQ = strQ & ", ""urn:schemas:mailheader:subject"""
strQ = strQ & ", ""urn:schemas:mailheader:received"""
strQ = strQ & ", ""DAV:contentclass"""
strQ = strQ & ", ""DAV:displayname"""
strQ = strQ & ", ""DAV:href"""
strQ = strQ & " from scope ('shallow traversal of "
strQ = strQ & Chr(34) & "" & URL & Chr(34) & "') "
strQ = strQ & " WHERE ""DAV:ishidden"" = False"
f1.Writeline(strQ & vbCrLf)
rs.Open strQ, Conn

f1.Writeline("Error Number: " & Err.Number & vbcrlf)
Err.Clear
rs.movefirst
objRegExpr.Pattern = "mypattern"
Do until rs.EOF
Err.Clear
'f1.Writeline(rs.Fields("DAV:displayname") & vbcrlf )
f1.Writeline("Received: " &
rs.Fields("urn:schemas:mailheader:received") & vbcrlf)
f1.Writeline("Date: " &
rs.Fields("urn:schemas:mailheader:date") &
vbcrlf)
f1.Writeline("DisplayName: " & rs.Fields("DAV:displayname") &
vbcrlf)
f1.Writeline("Subject: " &
rs.Fields("urn:schemas:mailheader:subject") & vbcrlf)
getUserInfo(rs.Fields("urn:schemas:mailheader:subject"))
rs.MoveNext
Loop

Function getUserInfo(strSubject)
If strSubject <> "" Then
f1.Writeline("strSubject: " & strSubject & vbcrlf)
If objRegExpr.Test(strSubject) Then
Set Matches = objRegExpr.Execute(strSubject) '
Execute search.

For Each Match in Matches ' Iterate Matches
collection.
f1.Writeline("Match Value: " & Match.Value &
vbcrlf)
f1.Writeline("Match Index: " & Match.FirstIndex
& vbcrlf)
f1.Writeline("Matches Count: " & Matches.Count)
Next
Else
End If
End Function

f1.Close
Set objFSO = Nothing
rs.Close
Set rs = Nothing
'**********************************************************************************************
any help would be greatly appreciated.
Back to top
Brett
Guest





Posted: Thu Dec 01, 2005 5:58 pm    Post subject: Re: Urgent - Access message body from ado recordset? Reply with quote

Yes, I found this last night. Downloaded the Exchange SDK, it's a big
help!!!

Thanks!

Back to top
Mark Micallef
Guest





Posted: Tue Dec 20, 2005 9:58 am    Post subject: Re: Urgent - Access message body from ado recordset? Reply with quote

Hello Dave / Brett,

I have a question for you if I may. I need to integrate an existing
server application with Exchange to check for mail in one or more
mailboxes, and retrieve it. Can I use the method you describe to do
this? If so, could you recommend a website or other source of
information that would provide additional info? I took a look at MSDN
but it's not entirely clear.

Kind regards,
Mark

Dave Kane [MVP - Outlook] wrote:

Quote:
Have you tried to get 'urn:schemas:httpmail:textdescription' and/or
'urn:schemas:httpmail:htmldescription'?

"Brett" <brett.mack@gmail.com> wrote in message
news:1133386230.766091.240890@f14g2000cwb.googlegroups.com...


I'm using the below code to access a collection of messages in a
particular mailbox / folder. I can see how to access many fields, but I
can't see how to access the actual message contents (body). Using
exchange
explorer, it doesn't show a field which seems to contain the actual
message body. I need to pass it to "getuserinfo" to parse it out with a
regular expression.

Do I have to use CDO for this? How? Below is my code:
'***********************************************************************************************************
Dim objFSO, f1

Set objFSO = Createobject("Scripting.FileSystemObject")
Set f1 = objFSO.CreateTextFile("d:\scripts\exchange\evlog.txt", True)

Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Conn.Provider = "ExOLEDB.DataSource"
Conn.Open "file:\\.\backofficestorage\mailboxlocation"
Dim strQ, url, rs, rsrecord
Dim objRegExpr, retStr, MatchesI, Match
Set objRegExpr = New RegExp
objRegExpr.Global = True
objRegExpr.IgnoreCase = True

URL = "file:\\.\backofficestorage\mailboxlocation"

strQ = ""
strQ = "select "
strQ = strQ & " ""urn:schemas:mailheader:date"""
strQ = strQ & ", ""urn:schemas:httpmail:to"""
strQ = strQ & ", ""urn:schemas:httpmail:from"""
strQ = strQ & ", ""urn:schemas:mailheader:subject"""
strQ = strQ & ", ""urn:schemas:mailheader:received"""
strQ = strQ & ", ""DAV:contentclass"""
strQ = strQ & ", ""DAV:displayname"""
strQ = strQ & ", ""DAV:href"""
strQ = strQ & " from scope ('shallow traversal of "
strQ = strQ & Chr(34) & "" & URL & Chr(34) & "') "
strQ = strQ & " WHERE ""DAV:ishidden"" = False"
f1.Writeline(strQ & vbCrLf)
rs.Open strQ, Conn

f1.Writeline("Error Number: " & Err.Number & vbcrlf)
Err.Clear
rs.movefirst
objRegExpr.Pattern = "mypattern"
Do until rs.EOF
Err.Clear
'f1.Writeline(rs.Fields("DAV:displayname") & vbcrlf )
f1.Writeline("Received: " &
rs.Fields("urn:schemas:mailheader:received") & vbcrlf)
f1.Writeline("Date: " &
rs.Fields("urn:schemas:mailheader:date") &
vbcrlf)
f1.Writeline("DisplayName: " & rs.Fields("DAV:displayname") &
vbcrlf)
f1.Writeline("Subject: " &
rs.Fields("urn:schemas:mailheader:subject") & vbcrlf)
getUserInfo(rs.Fields("urn:schemas:mailheader:subject"))
rs.MoveNext
Loop

Function getUserInfo(strSubject)
If strSubject <> "" Then
f1.Writeline("strSubject: " & strSubject & vbcrlf)
If objRegExpr.Test(strSubject) Then
Set Matches = objRegExpr.Execute(strSubject) '
Execute search.

For Each Match in Matches ' Iterate Matches
collection.
f1.Writeline("Match Value: " & Match.Value &
vbcrlf)
f1.Writeline("Match Index: " & Match.FirstIndex
& vbcrlf)
f1.Writeline("Matches Count: " & Matches.Count)
Next
Else
End If
End Function

f1.Close
Set objFSO = Nothing
rs.Close
Set rs = Nothing
'**********************************************************************************************
any help would be greatly appreciated.






Back to top
Xavier BETOUX
Guest





Posted: Tue Dec 20, 2005 5:45 pm    Post subject: Re: Urgent - Access message body from ado recordset? Reply with quote

hello misters

i am writing this from france, please excuse my poor english

i have a similar problem

in fact i need to retreive the content of delivery status report
the hasattachment says that there is an attachment but i am unable to find a
method to get the content
the fileattachment is null or empty

could someone help

my application is an external server who has a sql database of different
companies and is dedicated to send mails to customers
i want to be able to forbid mails that are contained in the reports

thanks in advance


"Mark Micallef" wrote:

Quote:
Hello Dave / Brett,

I have a question for you if I may. I need to integrate an existing
server application with Exchange to check for mail in one or more
mailboxes, and retrieve it. Can I use the method you describe to do
this? If so, could you recommend a website or other source of
information that would provide additional info? I took a look at MSDN
but it's not entirely clear.

Kind regards,
Mark

Dave Kane [MVP - Outlook] wrote:

Have you tried to get 'urn:schemas:httpmail:textdescription' and/or
'urn:schemas:httpmail:htmldescription'?

"Brett" <brett.mack@gmail.com> wrote in message
news:1133386230.766091.240890@f14g2000cwb.googlegroups.com...


I'm using the below code to access a collection of messages in a
particular mailbox / folder. I can see how to access many fields, but I
can't see how to access the actual message contents (body). Using
exchange
explorer, it doesn't show a field which seems to contain the actual
message body. I need to pass it to "getuserinfo" to parse it out with a
regular expression.

Do I have to use CDO for this? How? Below is my code:
'***********************************************************************************************************
Dim objFSO, f1

Set objFSO = Createobject("Scripting.FileSystemObject")
Set f1 = objFSO.CreateTextFile("d:\scripts\exchange\evlog.txt", True)

Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Conn.Provider = "ExOLEDB.DataSource"
Conn.Open "file:\\.\backofficestorage\mailboxlocation"
Dim strQ, url, rs, rsrecord
Dim objRegExpr, retStr, MatchesI, Match
Set objRegExpr = New RegExp
objRegExpr.Global = True
objRegExpr.IgnoreCase = True

URL = "file:\\.\backofficestorage\mailboxlocation"

strQ = ""
strQ = "select "
strQ = strQ & " ""urn:schemas:mailheader:date"""
strQ = strQ & ", ""urn:schemas:httpmail:to"""
strQ = strQ & ", ""urn:schemas:httpmail:from"""
strQ = strQ & ", ""urn:schemas:mailheader:subject"""
strQ = strQ & ", ""urn:schemas:mailheader:received"""
strQ = strQ & ", ""DAV:contentclass"""
strQ = strQ & ", ""DAV:displayname"""
strQ = strQ & ", ""DAV:href"""
strQ = strQ & " from scope ('shallow traversal of "
strQ = strQ & Chr(34) & "" & URL & Chr(34) & "') "
strQ = strQ & " WHERE ""DAV:ishidden"" = False"
f1.Writeline(strQ & vbCrLf)
rs.Open strQ, Conn

f1.Writeline("Error Number: " & Err.Number & vbcrlf)
Err.Clear
rs.movefirst
objRegExpr.Pattern = "mypattern"
Do until rs.EOF
Err.Clear
'f1.Writeline(rs.Fields("DAV:displayname") & vbcrlf )
f1.Writeline("Received: " &
rs.Fields("urn:schemas:mailheader:received") & vbcrlf)
f1.Writeline("Date: " &
rs.Fields("urn:schemas:mailheader:date") &
vbcrlf)
f1.Writeline("DisplayName: " & rs.Fields("DAV:displayname") &
vbcrlf)
f1.Writeline("Subject: " &
rs.Fields("urn:schemas:mailheader:subject") & vbcrlf)
getUserInfo(rs.Fields("urn:schemas:mailheader:subject"))
rs.MoveNext
Loop

Function getUserInfo(strSubject)
If strSubject <> "" Then
f1.Writeline("strSubject: " & strSubject & vbcrlf)
If objRegExpr.Test(strSubject) Then
Set Matches = objRegExpr.Execute(strSubject) '
Execute search.

For Each Match in Matches ' Iterate Matches
collection.
f1.Writeline("Match Value: " & Match.Value &
vbcrlf)
f1.Writeline("Match Index: " & Match.FirstIndex
& vbcrlf)
f1.Writeline("Matches Count: " & Matches.Count)
Next
Else
End If
End Function

f1.Close
Set objFSO = Nothing
rs.Close
Set rs = Nothing
'**********************************************************************************************
any help would be greatly appreciated.







Back to top
Dave Kane [MVP - Outlook]
Guest





Posted: Wed Dec 21, 2005 12:06 am    Post subject: Re: Urgent - Access message body from ado recordset? Reply with quote

Mark,

I understand - it's not always clear to people who work with it all the time. There are a few different APIs you can use to get data from a mailbox and the decision about which one to use depends on what's available to you. The way that Brett is accessing the data (ADO with an EXOLEDB provider) only works running on the Exchange server itself. You can get to the mailbox data from other machines through a MAPI session using of the CDO libraries. You can also request the data over HTTP using WebDAV if your Exchange server is configured for that.
The Exchange SDK has documentation and sample code(http://msdn.microsoft.com/library/default.asp?url=/downloads/list/exchange.asp) and is a good place to start. You may also find just what you need on www.outlookcode.com

Good luck,

Dave
"Mark Micallef" <mark.micallef@unspell.you.see.a.mess.net> wrote in message news:43A78CCE.6010601@unspell.you.see.a.mess.net...
Hello Dave / Brett,

I have a question for you if I may. I need to integrate an existing server application with Exchange to check for mail in one or more mailboxes, and retrieve it. Can I use the method you describe to do this? If so, could you recommend a website or other source of information that would provide additional info? I took a look at MSDN but it's not entirely clear.

Kind regards,
Mark

Dave Kane [MVP - Outlook] wrote:
Have you tried to get 'urn:schemas:httpmail:textdescription' and/or
'urn:schemas:httpmail:htmldescription'?

"Brett" <brett.mack@gmail.com> wrote in message
news:1133386230.766091.240890@f14g2000cwb.googlegroups.com...
I'm using the below code to access a collection of messages in a
particular mailbox / folder. I can see how to access many fields, but I
can't see how to access the actual message contents (body). Using
exchange
explorer, it doesn't show a field which seems to contain the actual
message body. I need to pass it to "getuserinfo" to parse it out with a
regular expression.

Do I have to use CDO for this? How? Below is my code:
'***********************************************************************************************************
Dim objFSO, f1

Set objFSO = Createobject("Scripting.FileSystemObject")
Set f1 = objFSO.CreateTextFile("d:\scripts\exchange\evlog.txt", True)

Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Conn.Provider = "ExOLEDB.DataSource"
Conn.Open "file:\\.\backofficestorage\mailboxlocation"
Dim strQ, url, rs, rsrecord
Dim objRegExpr, retStr, MatchesI, Match
Set objRegExpr = New RegExp
objRegExpr.Global = True
objRegExpr.IgnoreCase = True

URL = "file:\\.\backofficestorage\mailboxlocation"

strQ = ""
strQ = "select "
strQ = strQ & " ""urn:schemas:mailheader:date"""
strQ = strQ & ", ""urn:schemas:httpmail:to"""
strQ = strQ & ", ""urn:schemas:httpmail:from"""
strQ = strQ & ", ""urn:schemas:mailheader:subject"""
strQ = strQ & ", ""urn:schemas:mailheader:received"""
strQ = strQ & ", ""DAV:contentclass"""
strQ = strQ & ", ""DAV:displayname"""
strQ = strQ & ", ""DAV:href"""
strQ = strQ & " from scope ('shallow traversal of "
strQ = strQ & Chr(34) & "" & URL & Chr(34) & "') "
strQ = strQ & " WHERE ""DAV:ishidden"" = False"
f1.Writeline(strQ & vbCrLf)
rs.Open strQ, Conn

f1.Writeline("Error Number: " & Err.Number & vbcrlf)
Err.Clear
rs.movefirst
objRegExpr.Pattern = "mypattern"
Do until rs.EOF
Err.Clear
'f1.Writeline(rs.Fields("DAV:displayname") & vbcrlf )
f1.Writeline("Received: " &
rs.Fields("urn:schemas:mailheader:received") & vbcrlf)
f1.Writeline("Date: " &
rs.Fields("urn:schemas:mailheader:date") &
vbcrlf)
f1.Writeline("DisplayName: " & rs.Fields("DAV:displayname") &
vbcrlf)
f1.Writeline("Subject: " &
rs.Fields("urn:schemas:mailheader:subject") & vbcrlf)
getUserInfo(rs.Fields("urn:schemas:mailheader:subject"))
rs.MoveNext
Loop

Function getUserInfo(strSubject)
If strSubject <> "" Then
f1.Writeline("strSubject: " & strSubject & vbcrlf)
If objRegExpr.Test(strSubject) Then
Set Matches = objRegExpr.Execute(strSubject) '
Execute search.

For Each Match in Matches ' Iterate Matches
collection.
f1.Writeline("Match Value: " & Match.Value &
vbcrlf)
f1.Writeline("Match Index: " & Match.FirstIndex
& vbcrlf)
f1.Writeline("Matches Count: " & Matches.Count)
Next
Else
End If
End Function

f1.Close
Set objFSO = Nothing
rs.Close
Set rs = Nothing
'**********************************************************************************************
any help would be greatly appreciated.
Back to top
Dave Kane [MVP - Outlook]
Guest





Posted: Wed Dec 21, 2005 12:47 am    Post subject: Re: Urgent - Access message body from ado recordset? Reply with quote

No apologies are necessary, your English is far better than my French.

I think you are referring to a non-delivery report (NDR). An Exchange NDR
includes a copy of the message that could not be delivered so the attachment
is not a file, it is an embedded message (attachment type d:x37050003 = 5).
The information that you want should be contained in the body of the NDR. It
will list the recipient's address and the reason that the message could not
be delivered.

"Xavier BETOUX" <Xavier BETOUX@discussions.microsoft.com> wrote in message
news:8E439425-7CAB-4432-9A12-F20402747E62@microsoft.com...
Quote:
hello misters

i am writing this from france, please excuse my poor english

i have a similar problem

in fact i need to retreive the content of delivery status report
the hasattachment says that there is an attachment but i am unable to find
a
method to get the content
the fileattachment is null or empty

could someone help

my application is an external server who has a sql database of different
companies and is dedicated to send mails to customers
i want to be able to forbid mails that are contained in the reports

thanks in advance


"Mark Micallef" wrote:

Hello Dave / Brett,

I have a question for you if I may. I need to integrate an existing
server application with Exchange to check for mail in one or more
mailboxes, and retrieve it. Can I use the method you describe to do
this? If so, could you recommend a website or other source of
information that would provide additional info? I took a look at MSDN
but it's not entirely clear.

Kind regards,
Mark

Dave Kane [MVP - Outlook] wrote:

Have you tried to get 'urn:schemas:httpmail:textdescription' and/or
'urn:schemas:httpmail:htmldescription'?

"Brett" <brett.mack@gmail.com> wrote in message
news:1133386230.766091.240890@f14g2000cwb.googlegroups.com...


I'm using the below code to access a collection of messages in a
particular mailbox / folder. I can see how to access many fields, but I
can't see how to access the actual message contents (body). Using
exchange
explorer, it doesn't show a field which seems to contain the actual
message body. I need to pass it to "getuserinfo" to parse it out with a
regular expression.

Do I have to use CDO for this? How? Below is my code:
'***********************************************************************************************************
Dim objFSO, f1

Set objFSO = Createobject("Scripting.FileSystemObject")
Set f1 = objFSO.CreateTextFile("d:\scripts\exchange\evlog.txt", True)

Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Conn.Provider = "ExOLEDB.DataSource"
Conn.Open "file:\\.\backofficestorage\mailboxlocation"
Dim strQ, url, rs, rsrecord
Dim objRegExpr, retStr, MatchesI, Match
Set objRegExpr = New RegExp
objRegExpr.Global = True
objRegExpr.IgnoreCase = True

URL = "file:\\.\backofficestorage\mailboxlocation"

strQ = ""
strQ = "select "
strQ = strQ & " ""urn:schemas:mailheader:date"""
strQ = strQ & ", ""urn:schemas:httpmail:to"""
strQ = strQ & ", ""urn:schemas:httpmail:from"""
strQ = strQ & ", ""urn:schemas:mailheader:subject"""
strQ = strQ & ", ""urn:schemas:mailheader:received"""
strQ = strQ & ", ""DAV:contentclass"""
strQ = strQ & ", ""DAV:displayname"""
strQ = strQ & ", ""DAV:href"""
strQ = strQ & " from scope ('shallow traversal of "
strQ = strQ & Chr(34) & "" & URL & Chr(34) & "') "
strQ = strQ & " WHERE ""DAV:ishidden"" = False"
f1.Writeline(strQ & vbCrLf)
rs.Open strQ, Conn

f1.Writeline("Error Number: " & Err.Number & vbcrlf)
Err.Clear
rs.movefirst
objRegExpr.Pattern = "mypattern"
Do until rs.EOF
Err.Clear
'f1.Writeline(rs.Fields("DAV:displayname") & vbcrlf )
f1.Writeline("Received: " &
rs.Fields("urn:schemas:mailheader:received") & vbcrlf)
f1.Writeline("Date: " &
rs.Fields("urn:schemas:mailheader:date") &
vbcrlf)
f1.Writeline("DisplayName: " & rs.Fields("DAV:displayname") &
vbcrlf)
f1.Writeline("Subject: " &
rs.Fields("urn:schemas:mailheader:subject") & vbcrlf)
getUserInfo(rs.Fields("urn:schemas:mailheader:subject"))
rs.MoveNext
Loop

Function getUserInfo(strSubject)
If strSubject <> "" Then
f1.Writeline("strSubject: " & strSubject & vbcrlf)
If objRegExpr.Test(strSubject) Then
Set Matches = objRegExpr.Execute(strSubject) '
Execute search.

For Each Match in Matches ' Iterate Matches
collection.
f1.Writeline("Match Value: " & Match.Value &
vbcrlf)
f1.Writeline("Match Index: " & Match.FirstIndex
& vbcrlf)
f1.Writeline("Matches Count: " & Matches.Count)
Next
Else
End If
End Function

f1.Close
Set objFSO = Nothing
rs.Close
Set rs = Nothing
'**********************************************************************************************
any help would be greatly appreciated.







Back to top
Xavier BETOUX
Guest





Posted: Wed Dec 21, 2005 9:58 am    Post subject: Re: Urgent - Access message body from ado recordset? Reply with quote

thanks a lot dave for your prompt answer

you did understand what i meant but i am unable to find the method for
retreiving then content of the ndr
i tried all the urn:schemas: and cannot find the way to access the ndr
it is my problem

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 Integer

' 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


' 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:content-class""" _
& ", ""urn:schemas:httpmail:datereceived""" _
& ", ""DAV:isfolder""" _
& ", ""DAV:getcontentlength""" _
& ", ""urn:schemas:httpmail:from""" _
& ", ""urn:schemas:httpmail:subject""" _
& ", ""urn:schemas:mailheader:importance""" _
& ", ""urn:schemas:httpmail:textdescription""" _
& ", ""urn:schemas:httpmail:hasattachment""" _
& ", ""urn:schemas:httpmail:attachmentfilename""" _
& ", ""urn:schemas:httpmail:content-media-type""" _
& ", ""urn:schemas:httpmail:read""" _
& ", ""urn:content-classes:reportmessage""" _
& ", ""urn:content-classes:dsn""" _
& ", ""urn:content-classes:mdn""" _

' 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 "c:\Test.cdo" For Output As 1

' Move to the first message.
Rs.MoveFirst

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

PBar.Value = PBar.Value + 1

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

' Get the message subject.
Set Flds = Rs.Fields
For Each Fld In Flds
Print #1, "Name="; Fld.Name; "=";
If Not IsNull(Fld.Value) Then Print #1, Fld.Value;
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:textdescription")
If Not IsNull(Fld.Value) Then Corps = Fld.Value
Set Fld = Flds("urn:schemas:httpmail:hasattachment")
If Not IsNull(Fld.Value) Then
Attachement = Fld.Value & " "
If Fld.Value Then
Set Fld = Flds("urn:schemas:httpmail:content-media-type")
If Not IsNull(Fld.Value) Then Attachement = Fld.Value
End If
End If
Set Fld = Flds("urn:content-classes:reportmessage")
If Not IsNull(Fld.Value) Then Attachement = Attachement & Fld.Value
& " "
Set Fld = Flds("urn:content-classes:dsn")
If Not IsNull(Fld.Value) Then Attachement = Attachement & Fld.Value
& " "
Set Fld = Flds("urn:content-classes:mdn")
If Not IsNull(Fld.Value) Then Attachement = Attachement & Fld.Value
& " "

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:

' Display error message.
'MsgBox Err.Description
ErrDevice = Err.Number
MsgErr = Err.Description
'Clean up.
'If Rec.State = adStateOpen Then Rec.Close
'Set Rec = Nothing
'Exit Function
Resume Next

End Function

"Dave Kane [MVP - Outlook]" wrote:

Quote:
No apologies are necessary, your English is far better than my French.

I think you are referring to a non-delivery report (NDR). An Exchange NDR
includes a copy of the message that could not be delivered so the attachment
is not a file, it is an embedded message (attachment type d:x37050003 = 5).
The information that you want should be contained in the body of the NDR. It
will list the recipient's address and the reason that the message could not
be delivered.
Back to top
Xavier BETOUX
Guest





Posted: Wed Dec 21, 2005 5:58 pm    Post subject: Re: Urgent - Access message body from ado recordset? Reply with quote

again thanks for your prompt anser

first the content (text) of the NDR is not in
urn:schemas:httpmail:textdescription
this is empty or Null ( see the following test)

second i restrict the iterations for test (more than 20 000 ndr in the
mailbox)

These are the first lines of the test.cdo file

Name=DAV:href=file://./backofficestorage/KSite/MBX/analyste/Boîte de
réception/Non remis %3A7DISTRI.com Les meilleures affaires du
web-21332.EML Name=DAV:content-class= Name=urn:schemas:httpmail:datereceived=21/12/2005
17:19:18
Name=DAV:isfolder=Faux Name=urn:schemas:httpmail:from=Administrateur système
<postmaster@KSite> Name=urn:schemas:httpmail:subject=Non remis :7DISTRI.com
Les meilleures affaires du
web Name=urn:schemas:httpmail:textdescription= Name=urn:schemas:httpmail:hasattachment=Vrai Name=urn:schemas:httpmail:read=Faux
Name=DAV:href=file://./backofficestorage/KSite/MBX/analyste/Boîte de
réception/Non remis %3A7DISTRI.com Les meilleures affaires du
web-21331.EML Name=DAV:content-class= Name=urn:schemas:httpmail:datereceived=21/12/2005
17:19:18
Name=DAV:isfolder=Faux Name=urn:schemas:httpmail:from=Administrateur système
<postmaster@KSite> Name=urn:schemas:httpmail:subject=Non remis :7DISTRI.com
Les meilleures affaires du
web Name=urn:schemas:httpmail:textdescription= Name=urn:schemas:httpmail:hasattachment=Vrai Name=urn:schemas:httpmail:read=Faux

so i discovered that DAV:href content an EML file and was triying to find a
method to open it with cdo message but for now it's time to leave the office
(30 past 6 pm)


this is the new 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 Integer

' 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 iDsrc As CDO.IDataSource

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:content-class""" _
& ", ""urn:schemas:httpmail:datereceived""" _
& ", ""DAV:isfolder""" _
& ", ""urn:schemas:httpmail:from""" _
& ", ""urn:schemas:httpmail:subject""" _
& ", ""urn:schemas:httpmail:textdescription""" _
& ", ""urn:schemas:httpmail:hasattachment""" _
& ", ""urn:schemas:httpmail:read""" _
& " 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 "c:\Test.cdo" For Output As 1

' Move to the first message.
Rs.MoveFirst

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

PBar.Value = PBar.Value + 1

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

' Get the message subject.
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:textdescription")
If Not IsNull(Fld.Value) Then Corps = Fld.Value
Set Fld = Flds("urn:schemas:httpmail:hasattachment")
If Not IsNull(Fld.Value) Then
Attachement = Fld.Value
If Fld.Value Then
Set Fld = Flds("DAV:content-class")
If Not IsNull(Fld.Value) Then Attachement = Attachement & " "
& Fld.Value
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:

' Display error message.
'MsgBox Err.Description
ErrDevice = Err.Number
MsgErr = Err.Description
'Clean up.
'If Rec.State = adStateOpen Then Rec.Close
'Set Rec = Nothing
'Exit Function
Resume Next

End Function

"Dave Kane [MVP - Outlook]" wrote:

Quote:
The content (text) of an NDR should be returned in
urn:schemas:httpmail:textdescription

Why do you exit your loop after examining only 20 messages?

Also urn:content-classes:reportmessage, urn:content-classes:dsn and
urn:content-classes:mdn should not be included as fields in your SELECT
statement. Each one is the name of a content class and is a possible
returned value of the DAV:content-class property.
Back to top
Dave Kane [MVP - Outlook]
Guest





Posted: Wed Dec 21, 2005 5:58 pm    Post subject: Re: Urgent - Access message body from ado recordset? Reply with quote

The content (text) of an NDR should be returned in
urn:schemas:httpmail:textdescription

Why do you exit your loop after examining only 20 messages?

Also urn:content-classes:reportmessage, urn:content-classes:dsn and
urn:content-classes:mdn should not be included as fields in your SELECT
statement. Each one is the name of a content class and is a possible
returned value of the DAV:content-class property.

"Xavier BETOUX" <XavierBETOUX@discussions.microsoft.com> wrote in message
news:26D973C8-32BD-4AFC-B284-965D7BD732E1@microsoft.com...
Quote:
thanks a lot dave for your prompt answer

you did understand what i meant but i am unable to find the method for
retreiving then content of the ndr
i tried all the urn:schemas: and cannot find the way to access the ndr
it is my problem

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 Integer

' 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


' 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:content-class""" _
& ", ""urn:schemas:httpmail:datereceived""" _
& ", ""DAV:isfolder""" _
& ", ""DAV:getcontentlength""" _
& ", ""urn:schemas:httpmail:from""" _
& ", ""urn:schemas:httpmail:subject""" _
& ", ""urn:schemas:mailheader:importance""" _
& ", ""urn:schemas:httpmail:textdescription""" _
& ", ""urn:schemas:httpmail:hasattachment""" _
& ", ""urn:schemas:httpmail:attachmentfilename""" _
& ", ""urn:schemas:httpmail:content-media-type""" _
& ", ""urn:schemas:httpmail:read""" _
& ", ""urn:content-classes:reportmessage""" _
& ", ""urn:content-classes:dsn""" _
& ", ""urn:content-classes:mdn""" _

' 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 "c:\Test.cdo" For Output As 1

' Move to the first message.
Rs.MoveFirst

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

PBar.Value = PBar.Value + 1

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

' Get the message subject.
Set Flds = Rs.Fields
For Each Fld In Flds
Print #1, "Name="; Fld.Name; "=";
If Not IsNull(Fld.Value) Then Print #1, Fld.Value;
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:textdescription")
If Not IsNull(Fld.Value) Then Corps = Fld.Value
Set Fld = Flds("urn:schemas:httpmail:hasattachment")
If Not IsNull(Fld.Value) Then
Attachement = Fld.Value & " "
If Fld.Value Then
Set Fld = Flds("urn:schemas:httpmail:content-media-type")
If Not IsNull(Fld.Value) Then Attachement = Fld.Value
End If
End If
Set Fld = Flds("urn:content-classes:reportmessage")
If Not IsNull(Fld.Value) Then Attachement = Attachement & Fld.Value
& " "
Set Fld = Flds("urn:content-classes:dsn")
If Not IsNull(Fld.Value) Then Attachement = Attachement & Fld.Value
& " "
Set Fld = Flds("urn:content-classes:mdn")
If Not IsNull(Fld.Value) Then Attachement = Attachement & Fld.Value
& " "

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:

' Display error message.
'MsgBox Err.Description
ErrDevice = Err.Number
MsgErr = Err.Description
'Clean up.
'If Rec.State = adStateOpen Then Rec.Close
'Set Rec = Nothing
'Exit Function
Resume Next

End Function

"Dave Kane [MVP - Outlook]" wrote:

No apologies are necessary, your English is far better than my French.

I think you are referring to a non-delivery report (NDR). An Exchange NDR
includes a copy of the message that could not be delivered so the
attachment
is not a file, it is an embedded message (attachment type d:x37050003 =
5).
The information that you want should be contained in the body of the NDR.
It
will list the recipient's address and the reason that the message could
not
be delivered.

Back to top
Mark Micallef
Guest





Posted: Thu Dec 22, 2005 1:58 am    Post subject: Re: Urgent - Access message body from ado recordset? Reply with quote

Thanks very much Dave, this is just the information I needed! :)

Kind regards,
Mark

Dave Kane [MVP - Outlook] wrote:

Quote:
Mark,

I understand - it's not always clear to people who work with it all
the time. There are a few different APIs you can use to get data from
a mailbox and the decision about which one to use depends on what's
available to you. The way that Brett is accessing the data (ADO with
an EXOLEDB provider) only works running on the Exchange server itself.
You can get to the mailbox data from other machines through a MAPI
session using of the CDO libraries. You can also request the data over
HTTP using WebDAV if your Exchange server is configured for that.
The Exchange SDK has documentation and sample
code(http://msdn.microsoft.com/library/default.asp?url=/downloads/list/exchange.asp)
and is a good place to start. You may also find just what you need on
www.outlookcode.com <http://www.outlookcode.com

Good luck,

Dave

"Mark Micallef" <mark.micallef@unspell.you.see.a.mess.net
mailto:mark.micallef@unspell.you.see.a.mess.net>> wrote in
message news:43A78CCE.6010601@unspell.you.see.a.mess.net...
Hello Dave / Brett,

I have a question for you if I may. I need to integrate an
existing server application with Exchange to check for mail in one
or more mailboxes, and retrieve it. Can I use the method you
describe to do this? If so, could you recommend a website or other
source of information that would provide additional info? I took a
look at MSDN but it's not entirely clear.

Kind regards,
Mark

Dave Kane [MVP - Outlook] wrote:

Have you tried to get 'urn:schemas:httpmail:textdescription' and/or
'urn:schemas:httpmail:htmldescription'?

"Brett" <brett.mack@gmail.com> wrote in message
news:1133386230.766091.240890@f14g2000cwb.googlegroups.com...


I'm using the below code to access a collection of messages in a
particular mailbox / folder. I can see how to access many fields, but I
can't see how to access the actual message contents (body). Using
exchange
explorer, it doesn't show a field which seems to contain the actual
message body. I need to pass it to "getuserinfo" to parse it out with a
regular expression.

Do I have to use CDO for this? How? Below is my code:
'***********************************************************************************************************
Dim objFSO, f1

Set objFSO = Createobject("Scripting.FileSystemObject")
Set f1 = objFSO.CreateTextFile("d:\scripts\exchange\evlog.txt", True)

Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Conn.Provider = "ExOLEDB.DataSource"
Conn.Open "file:\\.\backofficestorage\mailboxlocation"
Dim strQ, url, rs, rsrecord
Dim objRegExpr, retStr, MatchesI, Match
Set objRegExpr = New RegExp
objRegExpr.Global = True
objRegExpr.IgnoreCase = True

URL = "file:\\.\backofficestorage\mailboxlocation"

strQ = ""
strQ = "select "
strQ = strQ & " ""urn:schemas:mailheader:date"""
strQ = strQ & ", ""urn:schemas:httpmail:to"""
strQ = strQ & ", ""urn:schemas:httpmail:from"""
strQ = strQ & ", ""urn:schemas:mailheader:subject"""
strQ = strQ & ", ""urn:schemas:mailheader:received"""
strQ = strQ & ", ""DAV:contentclass"""
strQ = strQ & ", ""DAV:displayname"""
strQ = strQ & ", ""DAV:href"""
strQ = strQ & " from scope ('shallow traversal of "
strQ = strQ & Chr(34) & "" & URL & Chr(34) & "') "
strQ = strQ & " WHERE ""DAV:ishidden"" = False"
f1.Writeline(strQ & vbCrLf)
rs.Open strQ, Conn

f1.Writeline("Error Number: " & Err.Number & vbcrlf)
Err.Clear
rs.movefirst
objRegExpr.Pattern = "mypattern"
Do until rs.EOF
Err.Clear
'f1.Writeline(rs.Fields("DAV:displayname") & vbcrlf )
f1.Writeline("Received: " &
rs.Fields("urn:schemas:mailheader:received") & vbcrlf)
f1.Writeline("Date: " &
rs.Fields("urn:schemas:mailheader:date") &
vbcrlf)
f1.Writeline("DisplayName: " & rs.Fields("DAV:displayname") &
vbcrlf)
f1.Writeline("Subject: " &
rs.Fields("urn:schemas:mailheader:subject") & vbcrlf)
getUserInfo(rs.Fields("urn:schemas:mailheader:subject"))
rs.MoveNext
Loop

Function getUserInfo(strSubject)
If strSubject <> "" Then
f1.Writeline("strSubject: " & strSubject & vbcrlf)
If objRegExpr.Test(strSubject) Then
Set Matches = objRegExpr.Execute(strSubject) '
Execute search.

For Each Match in Matches ' Iterate Matches
collection.
f1.Writeline("Match Value: " & Match.Value &
vbcrlf)
f1.Writeline("Match Index: " & Match.FirstIndex
& vbcrlf)
f1.Writeline("Matches Count: " & Matches.Count)
Next
Else
End If
End Function

f1.Close
Set objFSO = Nothing
rs.Close
Set rs = Nothing
'**********************************************************************************************
any help would be greatly appreciated.






Back to top
Dave Kane [MVP - Outlook]
Guest





Posted: Thu Dec 22, 2005 5:58 pm    Post subject: Re: Urgent - Access message body from ado recordset? Reply with quote

Strange. The fact that the content-class is also null made me wonder, but I
notice that the property is misspelled. You should be requesting
"DAV:contentclass"

Have you looked at this mailbox in Exchange Explorer (which will take a
while with 20K+ messages)? Does it also show
urn:schemas:httpmail:textdescription as null/missing?

"Xavier BETOUX" <XavierBETOUX@discussions.microsoft.com> wrote in message
news:FA319366-AB20-4CB0-B194-979E5AD0395F@microsoft.com...
Quote:
again thanks for your prompt anser

first the content (text) of the NDR is not in
urn:schemas:httpmail:textdescription
this is empty or Null ( see the following test)

second i restrict the iterations for test (more than 20 000 ndr in the
mailbox)

These are the first lines of the test.cdo file

Name=DAV:href=file://./backofficestorage/KSite/MBX/analyste/Boîte de
réception/Non remis %3A7DISTRI.com Les meilleures affaires du
web-21332.EML Name=DAV:content-class=
Name=urn:schemas:httpmail:datereceived=21/12/2005
17:19:18
Name=DAV:isfolder=Faux Name=urn:schemas:httpmail:from=Administrateur
système
postmaster@KSite> Name=urn:schemas:httpmail:subject=Non remis
:7DISTRI.com
Les meilleures affaires du
web Name=urn:schemas:httpmail:textdescription=
Name=urn:schemas:httpmail:hasattachment=Vrai
Name=urn:schemas:httpmail:read=Faux
Name=DAV:href=file://./backofficestorage/KSite/MBX/analyste/Boîte de
réception/Non remis %3A7DISTRI.com Les meilleures affaires du
web-21331.EML Name=DAV:content-class=
Name=urn:schemas:httpmail:datereceived=21/12/2005
17:19:18
Name=DAV:isfolder=Faux Name=urn:schemas:httpmail:from=Administrateur
système
postmaster@KSite> Name=urn:schemas:httpmail:subject=Non remis
:7DISTRI.com
Les meilleures affaires du
web Name=urn:schemas:httpmail:textdescription=
Name=urn:schemas:httpmail:hasattachment=Vrai
Name=urn:schemas:httpmail:read=Faux

so i discovered that DAV:href content an EML file and was triying to find
a
method to open it with cdo message but for now it's time to leave the
office
(30 past 6 pm)


this is the new 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 Integer

' 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 iDsrc As CDO.IDataSource

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:content-class""" _
& ", ""urn:schemas:httpmail:datereceived""" _
& ", ""DAV:isfolder""" _
& ", ""urn:schemas:httpmail:from""" _
& ", ""urn:schemas:httpmail:subject""" _
& ", ""urn:schemas:httpmail:textdescription""" _
& ", ""urn:schemas:httpmail:hasattachment""" _
& ", ""urn:schemas:httpmail:read""" _
& " 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 "c:\Test.cdo" For Output As 1

' Move to the first message.
Rs.MoveFirst

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

PBar.Value = PBar.Value + 1

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

' Get the message subject.
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:textdescription")
If Not IsNull(Fld.Value) Then Corps = Fld.Value
Set Fld = Flds("urn:schemas:httpmail:hasattachment")
If Not IsNull(Fld.Value) Then
Attachement = Fld.Value
If Fld.Value Then
Set Fld = Flds("DAV:content-class")
If Not IsNull(Fld.Value) Then Attachement = Attachement & " "
& Fld.Value
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:

' Display error message.
'MsgBox Err.Description
ErrDevice = Err.Number
MsgErr = Err.Description
'Clean up.
'If Rec.State = adStateOpen Then Rec.Close
'Set Rec = Nothing
'Exit Function
Resume Next

End Function

"Dave Kane [MVP - Outlook]" wrote:

The content (text) of an NDR should be returned in
urn:schemas:httpmail:textdescription

Why do you exit your loop after examining only 20 messages?

Also urn:content-classes:reportmessage, urn:content-classes:dsn and
urn:content-classes:mdn should not be included as fields in your SELECT
statement. Each one is the name of a content class and is a possible
returned value of the DAV:content-class property.

Back to top
Dave Kane [MVP - Outlook]
Guest





Posted: Fri Dec 23, 2005 1:58 am    Post subject: Re: Urgent - Access message body from ado recordset? Reply with quote

I can repro that urn:schemas:httpmail:textdescription is blank for an NDR
where DAV:contentclass = urn:content-classes:dsn. It looks like the data
that you need is actually in the recipients collection. The recipient for
whom delivery failed is the only member of the recipients collection. The
message text is in the recipient's PR_REPORT_TEXT property (0x1001001E
http://schemas.microsoft.com/mapi/proptag/0x1001001E)

"Xavier BETOUX" <XavierBETOUX@discussions.microsoft.com> wrote in message
news:FA319366-AB20-4CB0-B194-979E5AD0395F@microsoft.com...
Quote:
again thanks for your prompt anser

first the content (text) of the NDR is not in
urn:schemas:httpmail:textdescription
this is empty or Null ( see the following test)

second i restrict the iterations for test (more than 20 000 ndr in the
mailbox)

These are the first lines of the test.cdo file

Name=DAV:href=file://./backofficestorage/KSite/MBX/analyste/Boîte de
réception/Non remis %3A7DISTRI.com Les meilleures affaires du
web-21332.EML Name=DAV:content-class=
Name=urn:schemas:httpmail:datereceived=21/12/2005
17:19:18
Name=DAV:isfolder=Faux Name=urn:schemas:httpmail:from=Administrateur
système
postmaster@KSite> Name=urn:schemas:httpmail:subject=Non remis
:7DISTRI.com
Les meilleures affaires du
web Name=urn:schemas:httpmail:textdescription=
Name=urn:schemas:httpmail:hasattachment=Vrai
Name=urn:schemas:httpmail:read=Faux
Name=DAV:href=file://./backofficestorage/KSite/MBX/analyste/Boîte de
réception/Non remis %3A7DISTRI.com Les meilleures affaires du
web-21331.EML Name=DAV:content-class=
Name=urn:schemas:httpmail:datereceived=21/12/2005
17:19:18
Name=DAV:isfolder=Faux Name=urn:schemas:httpmail:from=Administrateur
système
postmaster@KSite> Name=urn:schemas:httpmail:subject=Non remis
:7DISTRI.com
Les meilleures affaires du
web Name=urn:schemas:httpmail:textdescription=
Name=urn:schemas:httpmail:hasattachment=Vrai
Name=urn:schemas:httpmail:read=Faux

so i discovered that DAV:href content an EML file and was triying to find
a
method to open it with cdo message but for now it's time to leave the
office
(30 past 6 pm)


this is the new 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 Integer

' 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 iDsrc As CDO.IDataSource

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:content-class""" _
& ", ""urn:schemas:httpmail:datereceived""" _
& ", ""DAV:isfolder""" _
& ", ""urn:schemas:httpmail:from""" _
& ", ""urn:schemas:httpmail:subject""" _
& ", ""urn:schemas:httpmail:textdescription""" _
& ", ""urn:schemas:httpmail:hasattachment""" _
& ", ""urn:schemas:httpmail:read""" _
& " 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 "c:\Test.cdo" For Output As 1

' Move to the first message.
Rs.MoveFirst

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

PBar.Value = PBar.Value + 1

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

' Get the message subject.
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:textdescription")
If Not IsNull(Fld.Value) Then Corps = Fld.Value
Set Fld = Flds("urn:schemas:httpmail:hasattachment")
If Not IsNull(Fld.Value) Then
Attachement = Fld.Value
If Fld.Value Then
Set Fld = Flds("DAV:content-class")
If Not IsNull(Fld.Value) Then Attachement = Attachement & " "
& Fld.Value
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:

' Display error message.
'MsgBox Err.Description
ErrDevice = Err.Number
MsgErr = Err.Description
'Clean up.
'If Rec.State = adStateOpen Then Rec.Close
'Set Rec = Nothing
'Exit Function
Resume Next

End Function

"Dave Kane [MVP - Outlook]" wrote:

The content (text) of an NDR should be returned in
urn:schemas:httpmail:textdescription

Why do you exit your loop after examining only 20 messages?

Also urn:content-classes:reportmessage, urn:content-classes:dsn and
urn:content-classes:mdn should not be included as fields in your SELECT
statement. Each one is the name of a content class and is a possible
returned value of the DAV:content-class property.

Back to top
Xavier BETOUX
Guest





Posted: Fri Dec 23, 2005 4:52 pm    Post subject: Re: Urgent - Access message body from ado recordset? Reply with quote

many thanks again

i have no time today for testing

anayway meery christmas and talk to you next week

"Dave Kane [MVP - Outlook]" wrote:

Quote:
I can repro that urn:schemas:httpmail:textdescription is blank for an NDR
where DAV:contentclass = urn:content-classes:dsn. It looks like the data
that you need is actually in the recipients collection. The recipient for
whom delivery failed is the only member of the recipients collection. The
message text is in the recipient's PR_REPORT_TEXT property (0x1001001E
http://schemas.microsoft.com/mapi/proptag/0x1001001E)

"Xavier BETOUX" <XavierBETOUX@discussions.microsoft.com> wrote in message
news:FA319366-AB20-4CB0-B194-979E5AD0395F@microsoft.com...
again thanks for your prompt anser

first the content (text) of the NDR is not in
urn:schemas:httpmail:textdescription
this is empty or Null ( see the following test)

second i restrict the iterations for test (more than 20 000 ndr in the
mailbox)

These are the first lines of the test.cdo file

Name=DAV:href=file://./backofficestorage/KSite/MBX/analyste/Boîte de
réception/Non remis %3A7DISTRI.com Les meilleures affaires du
web-21332.EML Name=DAV:content-class=
Name=urn:schemas:httpmail:datereceived=21/12/2005
17:19:18
Name=DAV:isfolder=Faux Name=urn:schemas:httpmail:from=Administrateur
système
postmaster@KSite> Name=urn:schemas:httpmail:subject=Non remis
:7DISTRI.com
Les meilleures affaires du
web Name=urn:schemas:httpmail:textdescription=
Name=urn:schemas:httpmail:hasattachment=Vrai
Name=urn:schemas:httpmail:read=Faux
Name=DAV:href=file://./backofficestorage/KSite/MBX/analyste/Boîte de
réception/Non remis %3A7DISTRI.com Les meilleures affaires du
web-21331.EML Name=DAV:content-class=
Name=urn:schemas:httpmail:datereceived=21/12/2005
17:19:18
Name=DAV:isfolder=Faux Name=urn:schemas:httpmail:from=Administrateur
système
postmaster@KSite> Name=urn:schemas:httpmail:subject=Non remis
:7DISTRI.com
Les meilleures affaires du
web Name=urn:schemas:httpmail:textdescription=
Name=urn:schemas:httpmail:hasattachment=Vrai
Name=urn:schemas:httpmail:read=Faux

so i discovered that DAV:href content an EML file and was triying to find
a
method to open it with cdo message but for now it's time to leave the
office
(30 past 6 pm)


this is the new 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 Integer

' 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 iDsrc As CDO.IDataSource

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:content-class""" _
& ", ""urn:schemas:httpmail:datereceived""" _
& ", ""DAV:isfolder""" _
& ", ""urn:schemas:httpmail:from""" _
& ", ""urn:schemas:httpmail:subject""" _
& ", ""urn:schemas:httpmail:textdescription""" _
& ", ""urn:schemas:httpmail:hasattachment""" _
& ", ""urn:schemas:httpmail:read""" _
& " 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 "c:\Test.cdo" For Output As 1

' Move to the first message.
Rs.MoveFirst

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

PBar.Value = PBar.Value + 1

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

' Get the message subject.
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:textdescription")
If Not IsNull(Fld.Value) T