I have used this before and worked very well. though it was a few years ago now. It worked against Exchange 2003. not sure it works against Exchange 2008 though.
Public Function retrieve() As Boolean
Dim allOK As Boolean = True
Dim rec As ADODB.Record
Dim rs As ADODB.Recordset
Dim url As String
Dim sql As String
Dim iMessage As CDO.Message = New CDO.MessageClass
Dim numAttachments As Integer
Dim DeleteEmail As Boolean = False
Dim EmailsFound As Integer = 0
Try
rec = New ADODB.Record
rs = New ADODB.Recordset
url = "Url to outlook web access inbox"
rec.Open(url, , ConnectModeEnum.adModeReadWrite, , , AppSettings(MAILBOX_USERNAME), AppSettings(MAILBOX_PASSWORD))
' Build the SQL query for the messages.
sql = "select "
sql = sql & " ""urn:schemas:mailheader:subject"""
sql = sql & ", ""urn:schemas:httpmail:hasattachment"""
sql = sql & ", ""DAV:href"""
sql = sql & ", ""urn:schemas:httpmail:from"""
sql = sql & " from scope ('shallow traversal of "
sql = sql & """" & url & """" & "') "
If IsDebugEnabled Then log.Debug("retreieveEmails() - Opening Recordset:" & sql)
' Open the recordset.
rs.Open(sql, rec.ActiveConnection, CursorTypeEnum.adOpenUnspecified, LockTypeEnum.adLockOptimistic)
If Not rs.BOF And Not rs.EOF Then
rs.MoveFirst()
' Loop through all of the messages in the recordset
Do Until rs.EOF
EmailsFound += 1
DeleteEmail = False
If Not rs.Fields("urn:schemas:mailheader:subject").Value Is System.DBNull.Value Then
iMessage.DataSource.Open(System.Convert.ToString(rs.Fields("DAV:href").Value), rec.ActiveConnection, ADODB.ConnectModeEnum.adModeRead, ADODB.RecordCreateOptionsEnum.adFailIfNotExists, ADODB.RecordOpenOptionsEnum.adOpenSource, "", "")
'Check that the Attachment is an XML file
For Each objAttachment As CDO.IBodyPart In iMessage.Attachments
If CStr(objAttachment.FileName & "").ToUpper.EndsWith(".XML") Then
'Save the Attachment off
objAttachment.SaveToFile(IO.Path.Combine(AppSettings(TEMP_IN_DIR), objAttachment.FileName))
DeleteEmail = True
End If
Next
End If
If DeleteEmail Then
delete(rs.Fields("DAV:href").Value)
End If
rs.MoveNext()
Loop
Else
' No Emails Found
End If
Return True
Catch e As Exception
'Log the error
Return False
Finally
Try
rs.Close()
Catch
End Try
Try
rs = Nothing
Catch
End Try
Try
rec.Close()
Catch
End Try
Try
rec = Nothing
Catch
End Try
End Try
End Function