1

我正在尝试在 Outlook 的所有子文件夹中列出 Excel 中的所有电子邮件：

我已经搜索和研究了几个星期，但没有任何运气。

'Requires reference to Outlook library
Option Explicit

Public Sub ListOutlookFolders()

    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim rngOutput As Range
    Dim lngCol As Long
    Dim olItem As Outlook.MailItem

    Dim rng As Excel.Range
    Dim strSheet As String
    Dim strPath As String

    Set rngOutput = ActiveSheet.Range("A1")

    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")

    For Each olFolder In olNamespace.Folders
        rngOutput = olFolder.Name
        rngOutput.Offset(0, 1) = olFolder.Description
        Set rngOutput = rngOutput.Offset(1)
        For Each olItem In olFolder.Items
            Set rngOutput = rngOutput.Offset(1)
            With rngOutput
                .Offset(0, 1) = olItem.SenderEmailAddress ' Sender
            End With
        Next

        Set rngOutput = ListFolders(olFolder, 1, rngOutput)
    Next

    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing

End Sub

Function ListFolders(MyFolder As Outlook.MAPIFolder, Level As Integer, theOutput As Range) As Range        
    Dim olFolder As Outlook.MAPIFolder
    Dim olItem As Outlook.MailItem
    Dim lngCol As Long

    For Each olFolder In MyFolder.Folders
        theOutput.Offset(0, lngCol) = olFolder.Name
        Set theOutput = theOutput.Offset(1)

        If (olFolder.DefaultItemType = olMailItem) And (Not olFolder.Name = "Slettet post") Then
            For Each olItem In olFolder.Items
                If olItem.Class = olMail Then
                    With theOutput
                        .Offset(0, 1) = olItem.SenderEmailAddress ' Sender
                    End With
                    Set theOutput = theOutput.Offset(1)
                End If
            Next olItem <--- ERROR 13 here
        End If
        If olFolder.Folders.Count > 0 Then
            Set theOutput = ListFolders(olFolder, Level + 1, theOutput)
        End If
    Next olFolder
    Set ListFolders = theOutput.Offset(1)

End Function

该代码可以正常运行 10-20 个项目，然后在上述行中给我一个运行时错误 13，当我点击调试时，它告诉我 olItem = Nothing ！？- 当我点击单步时，代码再次运行良好一段时间。

我试图插入“ON ERROR”，但我的列表不包含所有电子邮件。

4

1 回答 1

3

我向你展示我的代码:)

更改
Dim olItem As Outlook.MailItem
为
Dim olItem As Object

并非所有文件夹项目都是邮件项目，因此请避免olItem以这种方式确定变量的尺寸。此更改在我的机器上运行良好，而最初我遇到了与您相同的错误

于 2012-04-12T10:36:23.913 回答