어딘가에서 발견 된이 코드로이 이상한 문제가 있습니다. 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에서 초보자입니다. 그래서 나와 양어하십시오. 사전에
덕분에
고마워요! 그것은 매력처럼 작동합니다! – Axbogen
좋은 캐치 @brettdj – Jesse