Hi. I keep getting an error as Invalid Next control variable reference for my below code. Any help would be greatly appreciated.
VBA Code:
Option Explicit
Sub ImportTable()
Cells.Clear
Dim OLApp As Outlook.Application
Set OLApp = New Outlook.Application
Dim ONS As Outlook.Namespace
Set ONS = OLApp.GetNamespace("MAPI")
Dim oMapi As Outlook.MAPIFolder
Dim myFolder As Outlook.Folder
Set myFolder = ONS.Folders("emailaddress").Folders("Inbox")
Set myFolder = myFolder.Folders("Custody mails")
Dim OLMAIL As Outlook.MailItem
Set OLMAIL = OLApp.CreateItem(olMailItem)
Dim intRow As Integer
Dim oItem As object
For Each OLMAIL In myFolder.Items
Dim oHTML As MSHTML.HTMLDocument
Set oHTML = New MSHTML.HTMLDocument
Dim oElColl As MSHTML.IHTMLElementCollection
With oHTML
.Body.innerHTML = OLMAIL.HTMLBody
Set oElColl = .getElementsByTagName("table")
End With
For Each oItem In oMapi.Items
If oItem.Subject = "Volume data" Then
Exit For
End If
'Next oItem
Dim t As Long, r As Long, c As Long
Dim eRow As Long
For t = 0 To oElColl.Length - 1
eRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
For r = 0 To (oElColl(t).Rows.Length - 1)
For c = 0 To (oElColl(t).Rows(r).Cells.Length - 1)
Range("A" & eRow).Offset(r, c).Value = oElColl(t).Rows(r).Cells(c).innerText
Next c
Next r
eRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Next t
'Cells(eRow, 1) = "Sender's Name:" & " " & OLMAIL.Sender
'Cells(eRow, 1).Interior.Color = vbRed
'Cells(eRow, 1).Font.Color = vbWhite
Cells(eRow, 1) = "Date & Time of Receipt:" & " " & OLMAIL.ReceivedTime
Cells(eRow, 1).Interior.Color = vbRed
Cells(eRow, 1).Font.Color = vbWhite
Cells(eRow, 1).Columns.AutoFit
Next OLMAIL
Range("A1").Select
Set OLApp = Nothing
Set OLMAIL = Nothing
Set oHTML = Nothing
Set oElColl = Nothing
On Error Resume Next
Range("A1:A" & Worksheets(1).UsedRange.Rows.Count).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'ThisWorkbook.VBProject.VBE.MainWindow.Visible = False
End Sub
Last edited by a moderator:
