■用意するもの
  ・Microsoft Exchange Web Services Managed API 2.0
  ・SharpDevelop 3.2以上(NET Frameworkのための統合開発環境(IDE))


■VB.NETでのコーディング(抜粋)
Imports Microsoft.Exchange.WebServices.Data
Imports System.Net
Imports System.Net.Security
Imports System.Security.Cryptography.X509Certificates

Public Class ClsEws
    Private EWService                   As ExchangeService  'Exchange Web Service
    Private EWSMessage                  As EmailMessage     'Exchange Web Service

    '下記クラスは今回のコーディングには紹介していないものです。
    Private ClEDB                       As New ClsEDB       'データベースクラス

    Private StrServerURL                As String = ""      'OWSサーバURL
    Private StrDomainName               As String = ""      'ドメイン名
    Private StrUserName                 As String = ""      'ユーザ名
    Private StrPassword                 As String = ""      'パスワード

    '***************************************************************************
    ' サーバ接続
    '***************************************************************************
    Public Sub ServerInit()
        '/ews/exchange.asmxはExchangeサーバ構築でデフォルト
        StrServerURL="https://ExchangeサーバURL/ews/exchange.asmx"
        StrDomainName="Exchangeに接続するときのドメイン名"
        StrUserName="Exchangeに接続するときのユーザ名"
        StrPassword="Exchangeに接続するときのパスワード"

        'ExchangeVersion.Exchange2007_SP1は、接続するExchangeサーバのバージョン
        'ExchangeVersion.Exchange2013       (Exchange 2010 SP2, Exchange 2010 SP3)
        'ExchangeVersion.Exchange2010_SP2   (Exchange 2010 SP1)
        'ExchangeVersion.Exchange2010       (Exchange 2010)
        'ExchangeVersion.Exchange2007_SP1   (Exchange 2007 SP1, Exchange 2007 SP2,Exchange 2007 SP3)
        EWService = New ExchangeService(requestedServerVersion:=ExchangeVersion.Exchange2007_SP1)
        'URL情報
        EWService.Url = New Uri(StrServerURL)
        'アカウント情報
        EWService.Credentials = New WebCredentials(StrUserName, StrPassword, StrDomainName)
        System.Net.ServicePointManager.ServerCertificateValidationCallback = New RemoteCertificateValidationCallback(AddressOf ValidateCertificate)
        
        '以下、Office365の接続定義
        ' EWService = New ExchangeService(ExchangeVersion.Exchange2010_SP2)
        'Dim Cache As CredentialCache = New CredentialCache()
        'Cache.Add(new Uri(), "Basic", new NetworkCredential(, ))
        'EWService.Credentials = Cache
        'EWService.Url = new Uri();
    End Sub

    '********************************************************************************************
    ' Httpsのセキュリティ対応
    '********************************************************************************************
    Private Function ValidateCertificate(ByVal sender As Object, ByVal certificate As X509Certificate, ByVal  chain As X509Chain, ByVal sslPolicyErrors As SslPolicyErrors) As Boolean
        'Return True to force the certificate to be accepted.
        Return True
    End Function

    '***************************************************************************
    ' メール受信一覧取得
    '***************************************************************************
    Public Sub RvHedGet(IntJFolder As Integer)
        Dim ItemV                       As ItemView
        Dim FindItem                    As FindItemsResults(Of Item) = Nothing
        Dim Im                          As Item
        Dim offset                      As Integer = 0
        Dim BolExistMailFlg             As Boolean = False      '過去受信済みフラグ
        Do 
            ItemV = New ItemView(50,offset)
            ItemV.Traversal = ItemTraversal.Shallow
            ' 受信するフォルダで分岐
            Select Case IntJFolder
                Case 0          ' 受信トレイ
                    FindItem = EWService.FindItems(WellKnownFolderName.Inbox, ItemV)            '受信トレイ
                Case 1          ' 送信済みトレイ
                    FindItem = EWService.FindItems(WellKnownFolderName.SentItems, ItemV)        '送信済みアイテム
                Case 2          ' 削除済みトレイ
                    FindItem = EWService.FindItems(WellKnownFolderName.DeletedItems, ItemV)     '削除済みアイテム
                Case 3          ' 下書きトレイ
                    FindItem = EWService.FindItems(WellKnownFolderName.Drafts, ItemV)           '下書き(送信者がNullなる)
            End Select
            
            For Each Im In FindItem
                Dim Msg As EmailMessage = Im
                'Databaseに同じメールが存在するか
                If ClEDB.ExistMail(Msg.Id.UniqueId) = True Then
                    BolExistMailFlg = True
                    Exit For
                End If
                '添付ファイルの件数を取得する場合は、Load()が必要となる
                Msg.Load()
                
                ClEDB.Mail.ToRecipients.Clear()
                ClEDB.Mail.CcRecipients.Clear()
                ClEDB.Mail.BccRecipients.Clear()
                ClEDB.Mail.Attachments.Clear()
                
                '新規メールはデータベースに登録
                ClEDB.Mail.UniqueId = Msg.ID.UniqueId
                If IntJFolder = 3 Then
                    ClEDB.Mail.SerderName = ""
                Else
                    '下書きトレイのときは送信者がない(削除トレイ含む)
                    Try
                        ClEDB.Mail.SerderName = Msg.Sender.Name
                    Catch Ex As Exception
                        ClEDB.Mail.SerderName = ""
                    End Try
                End If
                ClEDB.Mail.Subject = Msg.Subject
                'ClEDB.Mail.Body = Msg.Body.Text
                ClEDB.Mail.Body = Msg.Body.ToString()
                ClEDB.Mail.TrayID = IntJFolder
                ClEDB.Mail.RecvDateTime = Msg.DateTimeReceived
                ' 宛先取得
                For Each Recipients In Msg.ToRecipients
                    ClEDB.Mail.ToRecipients.Add(Recipients.Address)
                Next
                ' CC取得
                For Each Recipients In Msg.CcRecipients
                    ClEDB.Mail.ToRecipients.Add(Recipients.Address)
                Next
                ' BCC取得
                For Each Recipients In Msg.BccRecipients
                    ClEDB.Mail.ToRecipients.Add(Recipients.Address)
                Next

                ' 添付ファイルが存在するか
                For Each Attachment In Msg.Attachments
                    Select Case Attachment.GetType().Name
                        Case "FileAttachment"       '添付ファイル
                            Dim fileAttachment As FileAttachment
                            fileAttachment = Attachment
                            ClEDB.Mail.Attachments.Add(New ClsAttachments)
                            ClEDB.Mail.Attachments(ClEDB.Mail.Attachments.Count - 1 ).FileName = fileAttachment.Name
                            ClEDB.Mail.Attachments(ClEDB.Mail.Attachments.Count - 1 ).Type = 0
                        Case "ItemAttachment"       '添付メール
                            Dim itemAttachment As ItemAttachment
                            itemAttachment = Attachment
                            ClEDB.Mail.Attachments.Add(New ClsAttachments)
                            ClEDB.Mail.Attachments(ClEDB.Mail.Attachments.Count - 1 ).FileName = itemAttachment.Name
                            ClEDB.Mail.Attachments(ClEDB.Mail.Attachments.Count - 1 ).Type = 1
                    End Select
                Next

                ' データベース登録とXMLファイル作成
                ClEDB.InsertMail()
            Next

            ' データベースに登録済みのメールのとき
            If BolExistMailFlg = True Then
                Exit Do
            End If
            offset = offset + 50
        Loop While FindItem.MoreAvailable
    End Sub

    '***************************************************************************
    ' 添付ファイル取得
    '***************************************************************************
    Public Sub GetAttachment(StrTsId As String,StrUniqueId As String)
        Dim StrAttachmentsFile              As String
        Dim EMsg                            As EmailMessage = EmailMessage.Bind(EWService,StrUniqueId)
        
        StrAttachmentsFile=My.Application.Info.DirectoryPath & CnstAttDir
        ' フォルダーが存在しないときは作成する。
        If System.IO.Directory.Exists(StrAttachmentsFile) = False Then
            System.IO.Directory.CreateDirectory(StrAttachmentsFile)
        End If

        '添付ファイルの数取得
        If EMsg.Attachments.Count > 0 Then
            For Each emailAttachment In EMsg.Attachments
                Select Case emailAttachment.GetType().Name
                    '添付ファイル
                    Case "FileAttachment"
                        Dim fileAttachment As FileAttachment
                        fileAttachment = emailAttachment
                        '添付ファイル保存
                        StrAttachmentsFile = My.Application.Info.DirectoryPath
                        StrAttachmentsFile = StrAttachmentsFile & CnstAttDir
                        StrAttachmentsFile = StrAttachmentsFile & StrTsId & "_" & fileAttachment.Name
                        '添付ファイル抽出サンプル1
                        fileAttachment.Load(StrAttachmentsFile)
                        '添付ファイル抽出サンプル2
                        'Imports System.IO の宣言が必要
                        'Dim theStream As FileStream = New FileStream("C:\temp\" & fileAttachment.Name, FileMode.OpenOrCreate, FileAccess.ReadWrite)
                        'fileAttachment.Load(theStream)
                        'theStream.Close()
                        'theStream.Dispose()
                    '添付メール
                    Case "ItemAttachment"
                        Dim itemAttachment As ItemAttachment
                        itemAttachment = emailAttachment
                        itemAttachment.Load(New PropertySet(ItemSchema.MimeContent))
                        'eml形式にして保存
                        StrAttachmentsFile = My.Application.Info.DirectoryPath
                        StrAttachmentsFile = StrAttachmentsFile & CnstAttDir
                        StrAttachmentsFile = StrAttachmentsFile & StrTsId & "_" & itemAttachment.Name & ".eml"
                        Dim Mc As MimeContent =itemAttachment.Item.MimeContent
                        Dim Fs As New System.IO.FileStream(StrAttachmentsFile, System.IO.FileMode.Create)
                        Fs.Write(Mc.Content,0,Mc.Content.Length)
                        Fs.Close()
                    Case Else
                        Stop
                End Select
            Next
        End If
    End Sub

    '***************************************************************************
    ' メール送信
    '***************************************************************************
    Public Sub SendMail(ThBuf As ClsThread)
        Dim message As EmailMessage = New EmailMessage(EWService)
        'タイトル/メッセージ設定        
        message.Subject = ThBuf.Subject
        message.Body = ThBuf.Body
        message.Body.BodyType = BodyType.Text
        
        'Toの設定
        For Each StTo As String In ThBuf.ToRecipients
            If StTo.Length <> 0 Then
                message.ToRecipients.Add(StTo)
            End If
        Next
        
        'CCの設定
        For Each StCC As String In ThBuf.CcRecipients
            If StCC.Length <> 0 Then
                message.CcRecipients.Add(StCC)
            End If
        Next
        
        'BCC
        For Each StBCC As String In ThBuf.BccRecipients
            If StBCC.Length <> 0 Then
                message.BccRecipients.Add(StBCC)
            End If
        Next
        
        '添付ファイル
        For Each StAttachments As String In ThBuf.Attachments
            'StAttachmentsは添付するファイルのフルパスを指定
            message.Attachments.AddFileAttachment(StAttachments)
            'message.Update(ConflictResolutionMode.AlwaysOverwrite)
        Next

        '送信と保存
        message.SendAndSaveCopy()
    End Sub
End Class

▲TOP