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

如何在VB6中使用CDO（协作数据对象）阅读电子邮件和检索附件？

1 个答案: