Как читать электронную почту и получать вложения, используя CDO (Collaborative Data Object) в VB6?

Question

Кто-нибудь смог скачать письмо, которое содержит вложение с CDO в vb6?

Можете ли вы помочь мне с примером?

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