컴파일 오류 : 다음 대상 없음

Question

Outlook 2010의 특정 폴더와 관련된 모든 데이터를 Excel로 내보내려고합니다. To, From, Body, All date fields, Attachement 등이 필요합니다. 필드를 필드별로 정의하지 않고 모든 필드를 포함 할 수있는 방법이 있습니까?

아래 코드를 실행하면 컴파일 오류가 발생합니다.

나는 모든 IF가 닫혀 있다고 믿습니다.

Sub ExportToExcel() 

    On Error GoTo ErrHandler 
    Dim appExcel As Excel.Application 
    Dim wkb As Excel.Workbook 

Dim wks As Excel.Worksheet  
Dim rng As Excel.Range  
Dim strSheet As String  
Dim strPath As String  
Dim intRowCounter As Integer  
Dim intColumnCounter As Integer  
Dim msg As Outlook.MailItem  
Dim nms As Outlook.NameSpace  
Dim fld As Outlook.MAPIFolder  
Dim itm As Object 
    strSheet = "OutlookItems.xls" 
    strPath = "C:\" 

strSheet = strPath & strSheet  
Debug.Print strSheet 
'Select export folder Set nms = Application.GetNamespace("MAPI")  
Set fld = nms.PickFolder 
'Handle potential errors with Select Folder dialog box. 

If fld Is Nothing Then  
MsgBox "There are no mail messages to export", vbOKOnly, "Error"  
Exit Sub  
ElseIf fld.DefaultItemType <> olMailItem Then  
MsgBox "There are no mail messages to export", vbOKOnly, "Error"  
Exit Sub  
ElseIf fld.Items.Count = 0 Then  
MsgBox "There are no mail messages to export", vbOKOnly, "Error"  
Exit Sub  
End If 
    'Open and activate Excel workbook. 
Set appExcel = CreateObject("Excel.Application") 

appExcel.Workbooks.Open (strSheet)  
Set wkb = appExcel.ActiveWorkbook  
Set wks = wkb.Sheets(1)  
wks.Activate  
appExcel.Application.Visible = True 
    'Copy field items in mail folder. For Each itm In fld.Items  
intColumnCounter = 1  
Set msg = itm  
intRowCounter = intRowCounter + 1  
Set rng = wks.Cells(intRowCounter, intColumnCounter)  
rng.Value = msg.To  
intColumnCounter = intColumnCounter + 1  
Set rng = wks.Cells(intRowCounter, intColumnCounter)  
rng.Value = msg.SenderEmailAddress  
intColumnCounter = intColumnCounter + 1  
Set rng = wks.Cells(intRowCounter, intColumnCounter)  
rng.Value = msg.Subject  
intColumnCounter = intColumnCounter + 1  
Set rng = wks.Cells(intRowCounter, intColumnCounter)  
rng.Value = msg.Body  
intColumnCounter = intColumnCounter + 1  
Set rng = wks.Cells(intRowCounter, intColumnCounter)  
rng.Value = msg.SentOn  
intColumnCounter = intColumnCounter + 1  
Set rng = wks.Cells(intRowCounter, intColumnCounter)  
rng.Value = msg.ReceivedTime  
Next itm  
Set appExcel = Nothing   
Set wkb = Nothing  
Set wks = Nothing  
Set rng = Nothing  
Set msg = Nothing  
Set nms = Nothing  
Set fld = Nothing  
Set itm = Nothing  
Exit Sub  
ErrHandler: If Err.Number = 1004 Then  
MsgBox strSheet & " doesn't exist", vbOKOnly, "Error"  
Else  
MsgBox Err.Number & "; Description: ", vbOKOnly, "Error"  
End If  
Set appExcel = Nothing  
Set wkb = Nothing  
Set wks = Nothing  
Set rng = Nothing  
Set msg = Nothing  
Set nms = Nothing  
Set fld = Nothing  
Set itm = Nothing 
End Sub 

Answer 1

For/Next Loop의 문제는 아닙니다.

변경 라인

ErrHandler: If Err.Number = 1004 Then 

TIP

ErrHandler: 
If Err.Number = 1004 Then 

에 : 당신은 또한 this (점 4)를 참조 할 수 있습니다 :) 항상 코드를 들여?

편집 : 참조 위의 링크에 포인트 6을 참조뿐만 아니라 :) 코드에서 그것을 설명하기 위해이 또한

LetsContinue: 
    Set appExcel = Nothing 
    Set wkb = Nothing 
    Set wks = Nothing 
    Set rng = Nothing 
    Set msg = Nothing 
    Set nms = Nothing 
    Set fld = Nothing 
    Set itm = Nothing 
    Exit Sub 
ErrHandler: 
    If Err.Number = 1004 Then 
     MsgBox strSheet & " doesn't exist", vbOKOnly, "Error" 
    Else 
     MsgBox Err.Number & "; Description: ", vbOKOnly, "Error" 
    End If 

    Resume LetsContinue 
End Sub 

또 다른과 같이 쓸 수있다

Set appExcel = Nothing 
    Set wkb = Nothing 
    Set wks = Nothing 
    Set rng = Nothing 
    Set msg = Nothing 
    Set nms = Nothing 
    Set fld = Nothing 
    Set itm = Nothing 
    Exit Sub 
ErrHandler: 
    If Err.Number = 1004 Then 
     MsgBox strSheet & " doesn't exist", vbOKOnly, "Error" 
    Else 
     MsgBox Err.Number & "; Description: ", vbOKOnly, "Error" 
    End If 

    Set appExcel = Nothing 
    Set wkb = Nothing 
    Set wks = Nothing 
    Set rng = Nothing 
    Set msg = Nothing 
    Set nms = Nothing 
    Set fld = Nothing 
    Set itm = Nothing 
End Sub 

이 부분 예 :

If fld Is Nothing Then 
    MsgBox "There are no mail messages to export", vbOKOnly, "Error" 
    Exit Sub 
ElseIf fld.DefaultItemType <> olMailItem Then 
    MsgBox "There are no mail messages to export", vbOKOnly, "Error" 
    Exit Sub 
ElseIf fld.Items.Count = 0 Then 
    MsgBox "There are no mail messages to export", vbOKOnly, "Error" 
    Exit Sub 
End If 'Open and activate Excel workbook. Set appExcel = CreateObject("Excel.Application") 

Set wkb = appExcel.Workbooks.Open(strSheet) 
Set wks = wkb.Sheets(1) 
wks.Activate 

Exit Sub 너무 여러 번

당신은 당신의 코드에 전혀 Exit Sub을 사용하지 마십시오 사실에서 IF

의 Else 부분에 코드의 나머지 부분을 넣을 수 있습니다. 이유는, 당신의 코드는 파괴하고 당신이 만든 객체를 정리하지 않고 하위를 종료합니다. 정상적으로 절차를 종료합니다 :)

후속

이 코드를 사용해보십시오. 루프의 부분에 대한이의 일부임을

'Copy field items in mail folder. For Each itm In fld.Items 

주의 사항 : 코드를 가정 (안된)

Sub ExportToExcel() 
    On Error GoTo ErrHandler 

    '~~> Excel Objects/Variables 
    Dim appExcel As Excel.Application 
    Dim wkb As Excel.Workbook 
    Dim wks As Excel.Worksheet 

    Dim strSheet As String, strPath As String 
    Dim intRowCounter As Long, intColumnCounter As Long 

    '~~> Outlook Objects 
    Dim msg As Outlook.MailItem 
    Dim nms As Outlook.Namespace 
    Dim fld As Outlook.MAPIFolder 
    Dim itm As Object 

    strSheet = "OutlookItems.xls" 
    strPath = "C:\" 

    strSheet = strPath & strSheet 

    Set nms = Application.GetNamespace("MAPI") 
    Set fld = nms.PickFolder 

    If fld Is Nothing Then 
     MsgBox "There are no mail messages to export", vbOKOnly, "Error" 
    ElseIf fld.DefaultItemType <> olMailItem Then 
     MsgBox "There are no mail messages to export", vbOKOnly, "Error" 
    ElseIf fld.Items.Count = 0 Then 
     MsgBox "There are no mail messages to export", vbOKOnly, "Error" 
    Else 
     'Open and activate Excel workbook. 
     Set appExcel = CreateObject("Excel.Application") 

     Set wkb = appExcel.Workbooks.Open(strSheet) 
     Set wks = wkb.Sheets(1) 
     appExcel.Visible = True 

     'Copy field items in mail folder. 
     For Each itm In fld.Items 
      Set msg = itm 

      With wks 
       intRowCounter = intRowCounter + 1 
       .Cells(intRowCounter, intColumnCounter) = msg.To 

       intColumnCounter = intColumnCounter + 1 
       .Cells(intRowCounter, intColumnCounter) = msg.SenderEmailAddress 

       intColumnCounter = intColumnCounter + 1 
       .Cells(intRowCounter, intColumnCounter) = msg.Subject 

       intColumnCounter = intColumnCounter + 1 
       .Cells(intRowCounter, intColumnCounter) = msg.Body 

       intColumnCounter = intColumnCounter + 1 
       .Cells(intRowCounter, intColumnCounter) = msg.SentOn 

       intColumnCounter = intColumnCounter + 1 
       .Cells(intRowCounter, intColumnCounter) = msg.ReceivedTime 
      End With 
     Next itm 
    End If 
LetsContinue: 
    Set appExcel = Nothing 
    Set wkb = Nothing 
    Set wks = Nothing 
    Set msg = Nothing 
    Set nms = Nothing 
    Set fld = Nothing 
    Set itm = Nothing 
    Exit Sub 
ErrHandler: 
    If Err.Number = 1004 Then 
     MsgBox strSheet & " doesn't exist", vbOKOnly, "Error" 
    Else 
     MsgBox "Error Number: " & Err.Number & vbNewLine & _ 
       "Error Description: " & Err.Description, vbOKOnly, "Error" 
    End If 
    Resume LetsContinue 
End Sub 

Answer 2

가 붙여 넣은 것처럼 보이는, 당신은 오류가 발생하는 이유는이 라인 너의 코멘트?또한 다른 라인을 주석

'Copy field items in mail folder. 
For Each itm In fld.Items 

:

싯다 르트 나라 얀은 당신에게 그냥이 당신을 보여 선을 대체 문제의이 종류를 방지 할 수 있지만, 컴파일 코드를 얻기 위해 좋은 팁을 많이 준 :

'Select export folder Set nms = Application.GetNamespace("MAPI") 

은 다음과 같아야합니다 덴트 제안을

'Select export folder 
Set nms = Application.GetNamespace("MAPI")