Hopefully this will get you started in the right direction. NOTE: I have not had a chance to test this VB code, since I do not have access to an Exchange 2007 server from home (as far as I know). However, I wrote this code carefully, basing it on C# code that I know works, because I used it at my workplace. See this link: http://www.sqlteam.com/forums/topic.asp?TOPIC_ID=105257. And this one: https://social.msdn.microsoft.com/Forums/sqlserver/en-US/dd2b465b-b1d2-4c0d-82ec-c36c6c482d5d/populating-sql-server-from-emails?forum=sqltools
FURTHER NOTE: This code will DELETE each email after saving the attachments from it. I think it will be a hard delete as well. In other words, you won't be able to pull the emails back out of the Deleted Items folder. You have been warned.
(It is possible to just mark each email as read instead of deleting it, but I don't have time to write the code for that just now. Hopefully this will be enough for your needs. If you still need this question answered.)
Namespace StephenGTuggy.Examples.SaveEWS2007Attachments
Public Module EWS2007ExampleMain
Enum AuthenticationMethod
Windows
Basic
End Enum
Private Const sUserName As String = "SampleUserName"
Private Const sPassword As String = "SamplePassword1"
Private Const sDomain As String = "mycompany.com"
Private Const eAuthenticationMethod As AuthenticationMethod = AuthenticationMethod.Basic
Private Const sEWS_URL As String = "https://mailserver.mycompany.com/EWS/Exchange.asmx"
'Private Const sEmailSender As String = "[email protected]"
Private Const sSaveAttachmentsToDirectory As String = "C:\"
Public Sub Main()
' Set up credentials to use to connect to the Exchange server.
Dim nc As System.Net.NetworkCredential = Nothing
Select Case eAuthenticationMethod
Case AuthenticationMethod.Windows
nc = System.Net.CredentialCache.DefaultNetworkCredentials
Case Else
nc = New System.Net.NetworkCredential(sUserName, sPassword, sDomain)
End Select
' Now bind to Exchange.
Dim esb As New ExchangeWebServices.ExchangeServiceBinding
esb.Url = sEWS_URL
esb.Credentials = nc
' Main code....
Dim findItemRequest As New ExchangeWebServices.FindItemType
findItemRequest.Traversal = ExchangeWebServices.ItemQueryTraversalType.Shallow
' Define which item properties Exchange should return for each email.
Dim itemProperties As New ExchangeWebServices.ItemResponseShapeType
itemProperties.BaseShape = ExchangeWebServices.DefaultShapeNamesType.AllProperties
findItemRequest.ItemShape = itemProperties
' Identify which folders to search to find items.
Dim folderIDInbox As New ExchangeWebServices.DistinguishedFolderIdType
folderIDInbox.Id = ExchangeWebServices.DistinguishedFolderIdNameType.inbox
Dim folderIDArray As ExchangeWebServices.DistinguishedFolderIdType() = {folderIDInbox}
findItemRequest.ParentFolderIds = folderIDArray
' Limit result set to unread emails only.
Dim restriction As New ExchangeWebServices.RestrictionType
Dim isEqualTo As New ExchangeWebServices.IsEqualToType
Dim pathToFieldType As New PathToUnindexedFieldType
pathToFieldType.FieldURI = ExchangeWebServices.UnindexedFieldURIType.messageIsRead '.messageFrom
Dim constantType As New ExchangeWebServices.FieldURIOrConstantType
Dim constantValueType As New ExchangeWebServices.ConstantValueType
constantValueType.Value = "0" 'sEmailSender
constantType.Item = constantValueType
isEqualTo.Item = pathToFieldType
isEqualTo.FieldURIOrConstant = constantType
restriction.Item = isEqualTo
findItemRequest.Restriction = restriction
' Send the request to Exchange and get the response back.
System.Diagnostics.Trace.TraceInformation("Sending FindItem request....")
Dim findItemResponse As ExchangeWebServices.FindItemResponseType = esb.FindItem(findItemRequest)
System.Diagnostics.Trace.TraceInformation("Received response to FindItem request.")
' Process response from Exchange server.
Dim folder As ExchangeWebServices.FindItemResponseMessageType = _
CType(findItemResponse.ResponseMessages.Items(0), ExchangeWebServices.FindItemResponseMessageType)
Dim folderContents As ExchangeWebServices.ArrayOfRealItemsType = _
CType(folder.RootFolder.Item, ExchangeWebServices.ArrayOfRealItemsType)
Dim items As ExchangeWebServices.ItemType() = folderContents.Items
For Each curItem As ExchangeWebServices.ItemType In items
Dim iAttCount As Integer = GetFileAttachmentsCount(esb, curItem.ItemId)
System.Diagnostics.Trace.TraceInformation("Subject: {0} DisplayTo: {1} DateTimeReceived: {2} ItemClass: {3} AttachmentCount: {4}", _
curItem.Subject.Trim(), _
curItem.DisplayTo.Trim(), _
curItem.DateTimeReceived.TimeOfDay.ToString(), _
curItem.ItemClass.Trim(), _
iAttCount)
If iAttCount > 0 Then
GetAttachmentsOnItem(esb, curItem.ItemId, sSaveAttachmentsToDirectory)
If Not MarkItemAsProcessed(esb, curItem.ItemId) Then
System.Diagnostics.Trace.TraceError("Unable to mark email as processed.")
End If
End If
Next
System.Diagnostics.Trace.TraceInformation("Finished processing emails and attachments.")
End Sub
Function GetFileAttachmentsCount(binding As ExchangeWebServices.ExchangeServiceBinding, _
id As ExchangeWebServices.ItemIdType) As Integer
Dim iAttachmentCount As Integer = 0
' Use GetItem on the Id to get the Attachments collection.
Dim getItemRequest As New ExchangeWebServices.GetItemType
getItemRequest.ItemIds = New ExchangeWebServices.ItemIdType() {id}
getItemRequest.ItemShape = New ExchangeWebServices.ItemResponseShapeType
getItemRequest.ItemShape.BaseShape = ExchangeWebServices.DefaultShapeNamesType.AllProperties
Dim hasAttachPath As New ExchangeWebServices.PathToUnindexedFieldType
hasAttachPath.FieldURI = ExchangeWebServices.UnindexedFieldURIType.itemHasAttachments
Dim attachmentsPath As New ExchangeWebServices.PathToUnindexedFieldType
attachmentsPath.FieldURI = ExchangeWebServices.UnindexedFieldURIType.itemAttachments
' Add additional properties?
getItemRequest.ItemShape.AdditionalProperties = New ExchangeWebServices.BasePathToElementType() { _
hasAttachPath, attachmentsPath}
Dim getItemResponse As ExchangeWebServices.GetItemResponseType = binding.GetItem(getItemRequest)
Dim getItemResponseMessage As ExchangeWebServices.ItemInfoResponseMessageType = TryCast( _
getItemResponse.ResponseMessages.Items(0), ExchangeWebServices.ItemInfoResponseMessageType)
If getItemResponseMessage.ResponseCode = ExchangeWebServices.ResponseCodeType.NoError Then
Dim item As ExchangeWebServices.ItemType = getItemResponseMessage.Items.Items(0)
' Don't rely on HasAttachments -- it does not mean what you think it would.
If (item.Attachments IsNot Nothing) AndAlso (item.Attachments.Length > 0) Then
For attachmentIndex As Integer = 0 To item.Attachments.Length - 1
Dim almostAnAttachment As ExchangeWebServices.FileAttachmentType = TryCast( _
item.Attachments(attachmentIndex), ExchangeWebServices.FileAttachmentType)
If almostAnAttachment IsNot Nothing Then
iAttachmentCount = iAttachmentCount + 1
End If
Next
End If
End If
Return iAttachmentCount
End Function
Function MarkItemAsProcessed(esb As ExchangeWebServices.ExchangeServiceBinding, _
id As ExchangeWebServices.ItemIdType) As Boolean
Dim bReturn As Boolean = False
' Create the DeleteItem request.
Dim dit As New ExchangeWebServices.DeleteItemType
dit.ItemIds = New ExchangeWebServices.BaseItemIdType() {id}
' Delete the message.
Dim diResponse As ExchangeWebServices.DeleteItemResponseType = esb.DeleteItem(dit)
' Check the result.
If (diResponse.ResponseMessages.Items.Length > 0) AndAlso _
(diResponse.ResponseMessages.Items(0).ResponseClass = _
ExchangeWebServices.ResponseClassType.Success) Then
bReturn = True
End If
Return bReturn
End Function
Sub GetAttachmentsOnItem(binding As ExchangeWebServices.ExchangeServiceBinding, _
id As ExchangeWebServices.ItemIdType, _
destinationPath As String)
' STEP 1: We need to call GetItem on the Id so that we can get the Attachments collection back.
Dim getItemRequest As New ExchangeWebServices.GetItemType
getItemRequest.ItemIds = New ExchangeWebServices.ItemIdType() {id}
getItemRequest.ItemShape = New ExchangeWebServices.ItemResponseShapeType
' For this example, all we really need is the HasAttachments property and the Attachment collection.
' As such, let's just request those properties to reduce network traffic.
getItemRequest.ItemShape.BaseShape = ExchangeWebServices.DefaultShapeNamesType.IdOnly
Dim hasAttachPath As New ExchangeWebServices.PathToUnindexedFieldType
hasAttachPath.FieldURI = ExchangeWebServices.UnindexedFieldURIType.itemHasAttachments
Dim attachmentsPath As New ExchangeWebServices.PathToUnindexedFieldType
attachmentsPath.FieldURI = ExchangeWebServices.UnindexedFieldURIType.itemAttachments
' Add these to the list of properties to fetch....
getItemRequest.ItemShape.AdditionalProperties = New ExchangeWebServices.BasePathToElementType() { _
hasAttachPath, attachmentsPath}
' Now make the call.
Dim getItemResponse As ExchangeWebServices.GetItemResponseType = binding.GetItem(getItemRequest)
' getItem returns ItemInfoResponseMessages. Since we only requested one item, we should only
' get back one response message.
Dim getItemResponseMessage As ExchangeWebServices.ItemInfoResponseMessageType = TryCast( _
getItemResponse.ResponseMessages.Items(0), ExchangeWebServices.ItemInfoResponseMessageType)
' Like all good, happy and compliant developers [sic], we should check our response code....
If getItemResponseMessage.ResponseCode = ExchangeWebServices.ResponseCodeType.NoError Then
' STEP 2: Grab the Attachment IDs from our item
Dim item As ExchangeWebServices.ItemType = getItemResponseMessage.Items.Items(0)
If item.HasAttachments AndAlso item.Attachments IsNot Nothing AndAlso item.Attachments.Length > 0 Then
Dim attachmentIds As New List(Of ExchangeWebServices.RequestAttachmentIdType)
For attachmentIndex As Integer = 0 To item.Attachments.Length - 1
' For now, let's only consider file attachments instead of item attachments.
Dim almostAnAttachment As ExchangeWebServices.FileAttachmentType = TryCast( _
item.Attachments(attachmentIndex), ExchangeWebServices.FileAttachmentType)
If almostAnAttachment IsNot Nothing Then
' VERY IMPORTANT! The attachment collection returned by GetItem only has meta data
' about the attachments, but DOES NOT INCLUDE THE ACTUAL CONTENT. We must use
' GetAttachment to get the actual attachment.
Dim requestId As New ExchangeWebServices.RequestAttachmentIdType
requestId.Id = almostAnAttachment.AttachmentId.Id
attachmentIds.Add(requestId)
End If
Next
' Now that we have all of the attachment IDs, let's make a single GetAttachment call to
' get them all in one shot.
Dim getAttachmentRequest As New ExchangeWebServices.GetAttachmentType
' Oddly enough, just create an EMPTY (non-null) attachment response shape.
getAttachmentRequest.AttachmentShape = New ExchangeWebServices.AttachmentResponseShapeType
getAttachmentRequest.AttachmentIds = attachmentIds.ToArray()
Dim getAttachmentResponse As ExchangeWebServices.GetAttachmentResponseType = _
binding.GetAttachment(getAttachmentRequest)
' Now, here we asked for multiple items. As such, we will get back multiple response
' messages.
For Each attachmentResponseMessage As ExchangeWebServices.AttachmentInfoResponseMessageType _
In getAttachmentResponse.ResponseMessages.Items
If attachmentResponseMessage.ResponseCode = ExchangeWebServices.ResponseCodeType.NoError Then
' We only asked for file attachments above, so we should only get FileAttachments.
' If you are really paranoid, you can check for null after this again.
Dim fileAttachment As ExchangeWebServices.FileAttachmentType = TryCast( _
attachmentResponseMessage.Attachments(0), ExchangeWebServices.FileAttachmentType)
' Now, just save out the file contents.
Using file As System.IO.FileStream = System.IO.File.Create(System.IO.Path.Combine(destinationPath, fileAttachment.Name))
file.Write(fileAttachment.Content, 0, fileAttachment.Content.Length)
file.Flush()
file.Close()
End Using
End If
Next
End If
End If
End Sub
End Module
End Namespace
One final note: You will use the same .asmx link both to create the web reference to EWS and to connect to the server to make the actual calls. This had me stumped for a bit.
Good luck!
