|
Imports ReadMail.exchange
Imports System.Net
Imports System.IO
Imports System.Text
Public Class Form1
Public strUsername As String = "mailboxusernamehere"
Public strPassword As String = "mailboxpasswordhere"
Public strExchAsmx As String = "https://yourexchangeserverhere/EWS/Exchange.asmx"
Public strAttachPath As String = "C:\Mail\"
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Using exchangeServer As New ExchangeServiceBinding()
' This portion uses the credentials you provided and
' initiates the connection to the Web Service
Dim creds As ICredentials = New NetworkCredential(strUsername, strPassword)
exchangeServer.Credentials = creds
exchangeServer.Url = strExchAsmx
' Since this is not a folder search we opt for Shallow Traversal Type
Dim findItemRequest As New FindItemType()
findItemRequest.Traversal = ItemQueryTraversalType.Shallow
' The BaseShape property Gets or Sets the requested
' properties to return in a response
Dim itemProperties As New ItemResponseShapeType()
itemProperties.BaseShape = DefaultShapeNamesType.AllProperties
' Here the item shape property is set, Go To definition on
' FindItemType for more info
findItemRequest.ItemShape = itemProperties
' Setup a folder array and define the folder Name and then set the parent
' folder ID Field with it to filter the search to just the inbox.
Dim folderIDArray As DistinguishedFolderIdType() = New DistinguishedFolderIdType(0) {}
folderIDArray(0) = New DistinguishedFolderIdType()
folderIDArray(0).Id = DistinguishedFolderIdNameType.inbox
findItemRequest.ParentFolderIds = folderIDArray
' This block initiates the reading of the messages,
' Declares variables for the folder and items in that folder
Dim findItemResponse As FindItemResponseType = exchangeServer.FindItem(findItemRequest)
Dim folder As FindItemResponseMessageType = _
DirectCast(findItemResponse.ResponseMessages.Items(0), FindItemResponseMessageType)
Dim folderContents As New ArrayOfRealItemsType()
folderContents = DirectCast(folder.RootFolder.Item, ArrayOfRealItemsType)
Dim items As ItemType() = folderContents.Items
' if there are no items in the folder (Inbox) then exit
If items Is Nothing OrElse items.Count() <= 0 Then
MsgBox("No Items Found!")
Me.Close()
Exit Sub
End If
' Get the encoded ids of each item
Dim itemIds As BaseItemIdType() = New BaseItemIdType(items.Count() - 1) {}
For i As Integer = 0 To items.Count() - 1
itemIds(i) = items(i).ItemId
Next
' GetItemType is a class that represents a
' request to get items from a mailbox
Dim getItemType As New GetItemType()
' GetItemType variable here is defining the
' items to get in that request
getItemType.ItemIds = itemIds
getItemType.ItemShape = New ItemResponseShapeType()
getItemType.ItemShape.BaseShape = DefaultShapeNamesType.AllProperties
getItemType.ItemShape.BodyType = BodyTypeResponseType.Text
getItemType.ItemShape.BodyTypeSpecified = True
' This is the response from the exchange server with a number of messages
' that fit the parameters of the request
Dim getItemResponse As GetItemResponseType = exchangeServer.GetItem(getItemType)
Dim messages As ItemType() = New ItemType(getItemResponse.ResponseMessages.Items.Count() - 1) {}
Dim f As Integer = 0
Dim j As Integer = 0
Dim h As Integer = 0
' Here we loop through each message in that response and
' if we find an attachment we extract it
For j = 0 To messages.Count() - 1
'Here inside the loop we set the messages itemtype to
' a single message in the exchange response
messages(j) = DirectCast(getItemResponse.ResponseMessages.Items(j), _
ItemInfoResponseMessageType).Items.Items(0)
' We evaluate the message to see if it has attachments,
' we have no else portion so on to the next message
If (messages(j).HasAttachments = True) Then
f = f + 1
' In this block we see what is attached and get the resulting
' attachment id so that we can extract it
Dim request As New GetAttachmentType()
Dim responseShape As New AttachmentResponseShapeType()
responseShape.BodyType = BodyTypeResponseType.Text
responseShape.BodyTypeSpecified = True
request.AttachmentShape = responseShape
Dim ids As RequestAttachmentIdType() = New RequestAttachmentIdType(0) {}
ids(0) = New RequestAttachmentIdType()
ids(0).Id = Convert.ToString(messages(j).Attachments(0).AttachmentId.Id)
request.AttachmentIds = ids
Try
' Here we request the attachment from the exchange server
Dim response As GetAttachmentResponseType = exchangeServer.GetAttachment(request)
Dim rmta As ResponseMessageType() = response.ResponseMessages.Items
' For each attachment in the request per attachment ID within the single message
' we will get the attachment type and process each accordingly
For Each responseMessage As ResponseMessageType In rmta
Dim airmt As AttachmentInfoResponseMessageType = _
TryCast(responseMessage, _
AttachmentInfoResponseMessageType)
Dim attachments As AttachmentType() = airmt.Attachments
For Each attachment As AttachmentType In attachments
' Based on what the file type is it will be process or converted differently
' This portion does that. I have used this with word documents and images.
If TypeOf attachment Is FileAttachmentType Then
Dim TheFileAttachment As FileAttachmentType = _
DirectCast(attachment, FileAttachmentType)
Using File2Disk As Stream = New _
FileStream(strAttachPath & "\" & _
messages(j).Attachments(0).Name, FileMode.Create)
File2Disk.Write(TheFileAttachment.Content, 0, _
TheFileAttachment.Content.Length)
File2Disk.Flush()
File2Disk.Close()
End Using
Else
Dim TheItemAttachment As ItemType = _
DirectCast(attachment, ItemAttachmentType).Item
Dim ContentBytes() As Byte = _
Convert.FromBase64String(TheItemAttachment.MimeContent.Value)
Using Item2Disk As Stream = New _
FileStream(strAttachPath & "\" & _
messages(j).Attachments(0).Name + ".eml", FileMode.Create)
Item2Disk.Write(ContentBytes, 0, ContentBytes.Length)
Item2Disk.Flush()
Item2Disk.Close()
End Using
End If
h = h + 1
Next
Next
Catch x As Exception
Console.WriteLine(x.Message)
End Try
'' Remove these comments to delete messages after being extracted.
'Dim dit As New DeleteItemType()
'dit.ItemIds = New BaseItemIdType(0) {}
'Dim itemId As New ItemIdType()
'itemId.Id = messages(j).ItemId.Id
'dit.ItemIds(0) = itemId
'Dim diResponse As DeleteItemResponseType = exchangeServer.DeleteItem(dit)
End If
Next
'This message is simply to show how many items were processed
' and to serve as notice that the operation is complete
MsgBox(j & " messages read, " & f & " messages had attachments and " & h _
& " of those attachments were extracted!")
Me.Close()
End Using
End Sub
End Class
|
By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.
If a file you wish to view isn't highlighted, and is a text file (not binary), please
let us know and we'll add colourisation support for it.
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.