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 !? -シングルステップを押すと、コードはしばらくの間再び正常に実行されます。

「ONERROR」を挿入しようとしましたが、リストにすべてのメールが含まれていません。

4

1 に答える 1

3

私はあなたに私のコードをむき出しにしています:)


Dim olItem As Outlook.MailItem
に変更
Dim olItem As Object

すべてのフォルダーアイテムがメールアイテムになるわけではないためolItem、この方法で変数のディメンションを設定することは避けてください。この変更は私のマシンでは正常に機能しましたが、元々はあなたと同じエラーが発生しました

于 2012-04-12T10:36:23.913 に答える