email - VB6でCDO（Collaborative Data Object）を使用して電子メールを読み、添付ファイルを取得するにはどうすればよいですか？

Question

誰かがvb6でCDOの添付ファイルを含む電子メールをダウンロードできましたか？

例を教えていただけますか？

Answer 1

どこからメールを取得するかはまだわかりませんが、Exchangeサーバーからメールを取得するためのコードを次に示します。これは、別のプロジェクトで必要となるいくつかの方法を学ぶための実験として行ったので、本番品質ではありませんが、開始する必要があります。このコードは、これが実行されているコンピューターに既にセットアップされているExchangeクライアントに依存しています。

この関数は、セッションを作成してログインします。

Function Util_CreateSessionAndLogon(Optional LogOnName As Variant) As Boolean

    On Error GoTo err_CreateSessionAndLogon

    Set objSession = CreateObject("MAPI.Session")
    objSession.Logon , , False, False
    Util_CreateSessionAndLogon = True
    Exit Function

err_CreateSessionAndLogon:
    Util_CreateSessionAndLogon = False

    Exit Function

End Function

この関数は、受信ボックス内のアイテムに関する情報を取得し、使用可能なプロパティのいくつかを示します。

Public Function GetMessageInfo(ByRef msgArray() As String) As Long
    Dim objInboxFolder As Folder  ' Folder object
    Dim objInMessages As mapi.Messages ' Messages collection
    Dim objMessage As Message     ' Message object
    Dim InfoRtnString
    Dim i As Long
    Dim lngMsgCount As Long

    InfoRtnString = ""

    If objSession Is Nothing Then
        If Util_CreateSessionAndLogon = False Then
            Err.Raise 429, "IBS_MAPI_CLASS", "Unable to create MAPI session object."
            Exit Function
        End If
    End If

    Set objInboxFolder = objSession.Inbox
    Set objInMessages = objInboxFolder.Messages

    lngMsgCount = objInMessages.Count
    ReDim msgArray(0)   'initalize the array

    For Each objMessage In objInMessages
        If i / lngMsgCount * 100 > 100 Then
            RaiseEvent PercentDone(100)
        Else
            RaiseEvent PercentDone(i / lngMsgCount * 100)
        End If

        InfoRtnString = ""
        i = i + 1
        ReDim Preserve msgArray(i)
        InfoRtnString = InfoRtnString & Chr$(0) & objMessage.ID
        InfoRtnString = InfoRtnString & Chr$(0) & objMessage.Subject
        InfoRtnString = InfoRtnString & Chr$(0) & objMessage.Sender
        InfoRtnString = InfoRtnString & Chr$(0) & objMessage.TimeSent
        InfoRtnString = InfoRtnString & Chr$(0) & objMessage.TimeReceived
        InfoRtnString = InfoRtnString & Chr$(0) & "" 'objMessage.Text
        InfoRtnString = InfoRtnString & Chr$(0) & objMessage.Unread
        InfoRtnString = InfoRtnString & Chr$(0) & objMessage.Attachments.Count
        msgArray(i) = InfoRtnString
        DoEvents
    Next

    GetMessageInfo = i

End Function

この関数は、メッセージから添付ファイルを取得する方法を示しています。

Function GetAttachments(msgID As String, lstBox As ListBox) As Boolean
    Dim objMessage As Message ' Messages object
    Dim AttchName As String
    Dim i As Integer
    Dim x As Long

    If objSession Is Nothing Then
        x = Util_CreateSessionAndLogon()
    End If

    Set objMessage = objSession.GetMessage(msgID)

    For i = 1 To objMessage.Attachments.Count
        Select Case objMessage.Attachments.Item(i).Type

            Case Is = 1 'contents of a file
                AttchName = objMessage.Attachments.Item(i).Name
                If Trim$(AttchName) = "" Then
                    lstBox.AddItem "Could not read"
                Else
                    lstBox.AddItem AttchName
                End If

                lstBox.ItemData(lstBox.NewIndex) = i

            Case Is = 2 'link to a file
                lstBox.AddItem objMessage.Attachments.Item(i).Name
                lstBox.ItemData(lstBox.NewIndex) = i

            Case Is = 1 'OLE object


            Case Is = 4 'embedded object
                lstBox.AddItem "Embedded Object"
                lstBox.ItemData(lstBox.NewIndex) = i

        End Select

    Next i

    GetAttachments = True

End Function