如何在VB6中使用CDO(协同数据对象)阅读电子邮件和检索附件

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