2012-04-12 3 views
1

어딘가에서 발견 된이 코드로이 이상한 문제가 있습니다. Outlook의 모든 하위 폴더에있는 Excel의 모든 이메일을 나열하려고합니다.VBA (Excel) 런타임 오류 13 for-each 루프

행운을 보지 않고 몇 주 동안 검색하고 조사했습니다.

'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

난 당신이 내 코드를 드러내는 해요 :) 모든 폴더 항목이 mailitems, 그래서 피할
Dim olItem As Outlook.MailItem
Dim olItem As Object


변경 이 방법으로 변수 olItem의 치수를 지정하십시오. 이 변경 사항은 원래 내 컴퓨터에서 제대로 작동했지만 원래 같은 오류가 발생했습니다.

+1

고마워요! 그것은 매력처럼 작동합니다! – Axbogen

+0

좋은 캐치 @brettdj – Jesse