65.9K
CodeProject 正在变化。 阅读更多。
Home

使用 Exchange Web Services 和 VB.NET 提取 Exchange 附件

starIconstarIconstarIconstarIcon
emptyStarIcon
starIcon

4.88/5 (10投票s)

2012 年 12 月 6 日

CPOL

2分钟阅读

viewsIcon

68911

downloadIcon

1376

本文演示了如何使用 VB.NET 从 Exchange 提取附件。

引言

在本文中,我提供了一个短表单加载事件,您可以将其放置到空白 WinForms 项目中。在提供了代码最上部公共变量的适当值后,您应该能够运行该应用程序,并看到它会将所有附件从定义的 Exchange 邮箱提取到本地文件。

背景

这是我制作的一个应用程序的一小部分,该应用程序搜索并提取来自特定 Exchange 2007 邮箱的某些附件,提取后通过 StreamReader 读取,并将它们的固定长度字符串内容上传到 SQL 实例。本文涵盖了该任务的第一部分,因为我在尝试连接到 EWS 以提取附件时,尤其是对于 VB.NET,发现的信息很少。

注意

我保留了部分完成的代码,其中包含删除提取附件的消息的逻辑,但我已注释掉该部分。我将其保留完整,以便您可以取消注释它,如果删除消息是您想要做的事情。我发现我必须删除项目中的消息,否则邮箱处理时间过长,应用程序最终会超时,虽然可以调整超时时间,但这超出了本文的范围。

添加 Web 引用

您需要 Exchange Web Service 的 URL,它也是在下面的全局变量 strExchAsmx 中声明的 URL。如 此处 指示,您可以通过添加服务引用,然后按“高级”,再添加 Web 引用,在 VS2010 中添加 Web 引用。

代码

我没有将代码分解成更小的块并提供说明,而是选择在代码中添加注释信息,以便您在剪切和粘贴时可以在项目中获取它。

导入这些类。您可能会在 ReadMail.exchange 上收到错误,因为这是我的项目和 Web 引用的名称。在这里,您需要导入上面创建的 Web 引用。

Imports ReadMail.exchange
Imports System.Net
Imports System.IO
Imports System.Text

声明这些全局变量

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\"

将此放置在页面加载事件或您想要启动该过程的任何子例程中

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
© . All rights reserved.