Databases
StackOverflow2013
Postsdbo
PORuntime error looping through Outlook items
Body
 

Note that there are some explanatory texts on larger screens.

plurals
  1. PORuntime error looping through Outlook items
    text
    copied!<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>
 

Querying!

 
Guidance
An individual column

Larger individual text columns get their own page to allow for proper reading.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload