title: Runtime error looping through Outlook items
body: <p>I am using VBA in Outlook to extract mail information from items in the mainfolder and subfolder. The mainfolder failed to set(capture) the subfolder properties into it and it causes the runtime error.</p>
  
  <p>The runtime error differs whenever I run. For example, sometime I received -970718969 (c6240107) and another time I received -2044460793 (86240107).</p>
  
  <p>When I clicked debug, it points to this line of code:</p>
  
  <pre><code>For Each itm In subFld.Items
  </code></pre>
  
  <p>Here is the screenshot:
  <img src="https://i.stack.imgur.com/y3Jcw.png" alt="http://i.stack.imgur.com/y3Jcw.png"></p>
  
  <p>Here is the full code:</p>
  
  <pre><code>Public monthValue As Integer
  Public yearValue As String
  
  'Ensure Microsoft Excel 11.0 Object Library is ticked in tools.
  Sub ExportToExcel1()
  
  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 msg As Outlook.MailItem
  Dim nms As Outlook.NameSpace
  Dim mainFld As Outlook.MAPIFolder
  Dim subFld As Outlook.MAPIFolder
  Dim itm As Object
  Dim offsetRow As Long
  Dim emailCount As Long
  
  'Set the path of the excel file.
  strSheet = "For fun.xlsx"
  strPath = "C:\Users\xxxxxx\Desktop\xxxxx\"
  strSheet = strPath &amp; strSheet
  
  Debug.Print strSheet 
  
  Set nms = Application.GetNamespace("MAPI")
  Set mainFld = nms.PickFolder 'Open the box to select the file.
  
  'Handle potential errors with Select Folder dialog box.
  If mainFld Is Nothing Then
      MsgBox "Thank you for using this service.", vbOKOnly, "Error"
      Set nms = Nothing
      Set mainFld = Nothing
      Exit Sub
  ElseIf mainFld.DefaultItemType &lt;&gt; olMailItem Then
      MsgBox "Please select the correct folder.", vbOKOnly, "Error"
      Set nms = Nothing
      Set mainFld = Nothing
      Exit Sub
  ElseIf mainFld.Items.Count = 0 Then
      MsgBox "There are no mail messages to export", vbOKOnly, "Error"
      Set nms = Nothing
      Set mainFld = Nothing
      Exit Sub
  End If
  
  mainForm.Show
  'If user clicks cancel, it will exit sub.
  If yearValue = "" Then
      Set nms = Nothing
      Set mainFld = Nothing
      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 'Show my workbook.
  
  'Check if there are any subfolders.
  If mainFld.Folders.Count = 0 Then '1
      'No subfolder.
      For Each itm In mainFld.Items
          If itm.Class &lt;&gt; olMail Then '2
              'do nothing
          Else
              Set msg = itm
              'Validate the month and year for the email.
              If Month(msg.ReceivedTime) = monthValue And Year(msg.ReceivedTime) = yearValue Then '3
                  With wks
                      offsetRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                  End With
                  intRowCounter = 1 + offsetRow
                  Set rng = wks.Cells(intRowCounter, 1)
                      rng.Value = msg.ReceivedTime
                  Set rng = wks.Cells(intRowCounter, 2)
                      rng.Value = msg.SentOn
                  Set rng = wks.Cells(intRowCounter, 3)
                      rng.Value = msg.Subject
                  emailCount = 1 + emailCount 'Track the number of email.
              Else
                  'Do nothing
              End If '3
          End If '2
      Next itm
  Else
      'With subfolder
      For Each itm In mainFld.Items
          If itm.Class &lt;&gt; olMail Then '4
              'do nothing
          Else
              Set msg = itm
              If Month(msg.ReceivedTime) = monthValue And Year(msg.ReceivedTime) = yearValue Then '5
                  With wks
                      offsetRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                  End With
                  intRowCounter = 1 + offsetRow
                  Set rng = wks.Cells(intRowCounter, 1)
                      rng.Value = msg.ReceivedTime
                  Set rng = wks.Cells(intRowCounter, 2)
                      rng.Value = msg.SentOn
                  Set rng = wks.Cells(intRowCounter, 3)
                      rng.Value = msg.Subject
                  emailCount = 1 + emailCount
              Else
                  'Do nothing
              End If '5
          End If '4
      Next itm
      For Each subFld In mainFld.Folders
          For Each itm In subFld.Items
              If itm.Class &lt;&gt; olMail Then '6
                  'do nothing
              Else
                  Set msg = itm
                  If Month(msg.ReceivedTime) = monthValue And Year(msg.ReceivedTime) = yearValue Then '7
                      With wks
                          offsetRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                      End With
                      intRowCounter = 1 + offsetRow
                      Set rng = wks.Cells(intRowCounter, 1)
                          rng.Value = msg.ReceivedTime
                      Set rng = wks.Cells(intRowCounter, 2)
                          rng.Value = msg.SentOn
                      Set rng = wks.Cells(intRowCounter, 3)
                          rng.Value = msg.Subject
                      emailCount = 1 + emailCount
                  Else
                      'Do nothing
                  End If '7
              End If '6
          Next itm
      Next subFld
  End If '1
  
  
  Set appExcel = Nothing
  Set wkb = Nothing
  Set wks = Nothing
  Set rng = Nothing
  Set msg = Nothing
  Set nms = Nothing
  Set mainFld = Nothing
  Set subFld = Nothing
  Set itm = Nothing
  
  'Inform the user that there are no email.
  If emailCount = 0 Then
      MsgBox "No emails associated with this date: " &amp; MonthName(monthValue, True) &amp; " " &amp; yearValue, vbOKOnly, "No Emails"
  End If
  
  Exit Sub
  
  Set appExcel = Nothing
  Set wkb = Nothing
  Set wks = Nothing
  Set rng = Nothing
  Set msg = Nothing
  Set nms = Nothing
  Set mainFld = Nothing
  Set subFld = Nothing
  Set itm = Nothing
  
  End Sub
  </code></pre>