Home » excel » excel – Compile Error: Next without For

excel – Compile Error: Next without For

Posted by: admin May 14, 2020 Leave a comment

Questions:

I am trying to export all data related to a specific folder in my Outlook 2010 to Excel. I need the To, From, Body, All date fields, Has Attachement, etc.. Is there a way where I can include all the fields without defining field by field?

When I run the below code, I have a Compile Error: Next without For.

I believe all the IFs are closed.

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
How to&Answers:

It is not the problem of For/Next Loop.

Change the line

ErrHandler: If Err.Number = 1004 Then

to

ErrHandler: If Err.Number = 1004 Then

TIP: Always indent your code 🙂 You might also want to see this (point 4)?

EDIT: See Point 6 in the above link as well 🙂 To illustrate that in your code, see this part

    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

This can be also written as

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

Another example

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

You don’t need to use Exit Sub so many times

You can put the rest of the code in the Else part of the IF

In fact DO NOT use Exit Sub at all in your code. Reason being, your code will exit the sub without destroying and cleaning up the objects that you created. Exit the procedure gracefully 🙂

FOLLOWUP

Try this code. (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:

Assuming your code looks like what you pasted, the reason you are getting the error is this line:

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

Notice that the for part of your loop is part of your comment?

Siddharth gave you a lot of good tips to help avoid these kind of problems, but to get your code to compile just replace the line I showed you with this:

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

You also commented out another line:

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

Should be:

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