编译错误：下一个没有For

我正在尝试将与Outlook 2010中特定文件夹相关的所有数据导出到Excel。 我需要收件人，发件人，所有date字段，具有附件等。有没有一种方法，我可以包括所有的领域，而无需定义字段的字段？

当我运行下面的代码，我有一个编译错误：下一个没有。

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

提示 ：总是缩进你的代码:)你可能也想看到这个 （点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 。 原因是，你的代码将退出子而不破坏和清理你创build的对象。 优雅地退出程序:)

跟进

试试这个代码。 （ 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给了你很多好的提示来帮助你避免这些问题，但是为了让你的代码能够编译，只需要用下面的代码replace我给你看的代码：

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