How to read email and retrieve attachement using CDO (Collaborative Data Object) in VB6?

Question

Has anyone been able to download email that contains attachment with CDO in vb6?

Can you help me with an example?

Answer 1

I'm still not sure where you want to retrieve email from but here is some code for retrieving email from an Exchange server. I did this as an experiment to learn some methods I would need on another project so it is not production quality but should get you started. This code is dependent on an Exchange client already being setup on the computer this is running on.

This function creates a session and logs in:

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

This function get information on items in the inbox and demonstrates some of the available properties.

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

This function demonstrates getting attachments from a message.

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