編譯錯誤：下一步沒有對於

Question

我想將與Outlook 2010中特定文件夾相關的所有數據導出到Excel。我需要收件人，發件人，所有日期字段，附加信息等等。有沒有一種方法可以將所有字段包含在內，而無需按字段定義字段？

當我運行下面的代碼，我有一個編譯錯誤：下一個沒有For。

我相信所有的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 

到

ErrHandler: 
If Err.Number = 1004 Then 

提示：總是縮進代碼:)你可能也想看看this（4點）？

編輯：見第6點在上面的鏈接，以及:)爲了說明，在你的代碼，看到這部分

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 

這也可以寫成

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 

另一個示例

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分這麼多次

你可以把代碼的其餘部分中的IF

事實上Else部分做你的代碼中使用Exit Sub可言。原因在於，您的代碼將退出子版本而不銷燬和清理您創建的對象。退出程序正常:)

隨訪

試試這個代碼。 （UNTESTED）

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 

請注意，您的循環的一部分的一部分你的評論？

亞洲時報Siddharth給了你很多的很好的技巧，以幫助避免這些類型的問題，但讓你的代碼編譯只需更換行我向您展示了這一點：

'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")