2012-04-12 39 views
1

私はどこかで見つけたこのコードでこの奇妙な問題を抱えています。私はすべての電子メールをOutlookのすべてのサブフォルダ内のExcelで一覧表示しようとしています:VBA(Excel)for-eachループで実行時エラー13が発生する

私はこれを何週間も検索し、調査しました。

'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は=何もしないことを私に語りましたか!? - 私がシングルステップを押すと、もう一度コードがやり直します。

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

私はプログラミングVBAの初心者ですので、私と一緒に裸をしてください。

事前

答えて

3

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

を変更
Dim olItem As Outlook.MailItem

Dim olItem As Object

しないように、すべてのフォルダのアイテムはmailitemsなるので、避けることができますこの方法で変数olItemの寸法を設定してください。この変更は私のマシンでうまくいきましたが、もともと同じエラーがあったのですが

+1

ありがとう!それは魅力のように働く! – Axbogen

+0

ニースキャッチ@brettdj – Jesse

関連する問題