如何在VB6中使用CDO(协作数据对象)阅读电子邮件和检索附件? [英] How to read email and retrieve attachement using CDO (Collaborative Data Object) in VB6?

问题描述

有人能在vb6中下载包含CDO附件的电子邮件吗?

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

你能帮我举个例子吗?

推荐答案

我仍然不确定您要从哪里检索电子邮件，但是这里有一些用于从Exchange服务器检索电子邮件的代码.我做此实验的目的是学习在另一个项目中需要的一些方法，因此这不是生产质量，但应该可以帮助您入门. 此代码取决于运行该计算机的计算机上已经设置的Exchange客户端.

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

这篇关于如何在VB6中使用CDO(协作数据对象)阅读电子邮件和检索附件?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！