Exchange Server

Brett · Guest

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. 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? 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, Matches, 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.

	Exchange Server Forum Index -> Development	All times are GMT
Page 1 of 1