Copy from email to excel - excel

Question

I'm not an expert in VBA, got an error which I can't figure out, can you please help advise?
I need an excel macro to copy from all the emails in a folder to my excel, googled and found the below code. The code runs fine for some emails, after that there will be a runtime error 440: array index out of bounds at this line.
abody = Split(objfolder.Items(i).Body, vbNewLine)
Most of the time I just record macro and edit from there so I don't really understand what is array index out of bounds.
Really hope you can enlighten me, thank you so much in advance for your help... =)
Full code can be found below...
Added in the part where the macro will get the details of the email it's processing... But what is baffling me is the received details of the email does not match the body. Can anyone please help advise?
Sub test()
Dim olApp As Object
Dim olNS As Object
Dim olFldr As Object
Dim olMail As Object
Dim i As Integer
Dim j As Long
Dim abody() As String
Dim Cnt As Long
Dim arrData() As Variant
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set olFldr = olNS.GetDefaultFolder(olFolderInbox).Folders("temp")
Cnt = 0
For Each olMail In olFldr.Items
On Error GoTo errorhandler
Cnt = Cnt + 1
abody = Split(olFldr.Items(Cnt).Body, vbNewLine)
For j = 0 To UBound(abody)
Sheet1.Cells(65000, 1).End(xlUp).Offset(1, 0).Value = abody(j)
Next
ReDim Preserve arrData(1 To 1, 1 To Cnt)
arrData(1, Cnt) = olMail.ReceivedTime
Cells(1, 1).Value = arrData(1, Cnt)
Cells(1, 1).NumberFormat = "dd/mm/yyyy hh:mm:ss AM/PM"
olFldr.Items(Cnt).Move olNS.GetDefaultFolder(6).Folders("Processed")
Next
Set olApp = Nothing
Set olNS = Nothing
Set olFldr = Nothing
errorhandler:
Application.CutCopyMode = False
Set olApp = Nothing
Set olNS = Nothing
Set olFldr = Nothing
Exit Sub
End Sub
updated code:
Sub test()
Dim olApp As Object
Dim olNS As Object
Dim olFldr As Object
Dim olMail As Object
Dim i As Integer
Dim j As Long
Dim abody() As String
Dim Cnt As Long
Dim arrData() As Variant
Dim ws As Worksheet
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set olFldr = olNS.GetDefaultFolder(olFolderInbox).Folders("temp")
Set ws = ThisWorkbook.Sheets("Sheet1")
EmailCount = olFldr.Items.Count
MsgBox "Number of emails in the folder: " & EmailCount, , "email count"
Cnt = 1
For Each olMail In olFldr.Items
abody = Split(olMail.Body, vbNewLine)
For j = 0 To UBound(abody)
ws.Cells(65000, 1).End(xlUp).Offset(1, 0).Value = abody(j)
Next
ReDim Preserve arrData(1 To 1, 1 To Cnt)
arrData(1, Cnt) = olMail.ReceivedTime
ws.Cells(1, 1).Value = arrData(1, Cnt)
ws.Cells(1, 1).NumberFormat = "dd/mm/yyyy hh:mm:ss AM/PM"
olMail.Move olNS.GetDefaultFolder(6).Folders("Processed")
Cnt = Cnt + 1
Next
Set olApp = Nothing
Set olNS = Nothing
Set olFldr = Nothing
End Sub

Answer 1

Can you try to change your looping part to this.
Also add the declaration and variable assignment for the target Worksheet.
Dim ws as Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1") 'added this to avoid the subscript out of range
Cnt = 1
For Each olMail In olFldr.Items
On Error GoTo errorhandler
abody = Split(olMail.Body, vbNewLine) 'changed this to olMail.Body since you are already iterating each mail
For j = 0 To UBound(abody)
ws.Cells(65000, 1).End(xlUp).Offset(1, 0).Value = abody(j) 'use the declared ws here
Next
ReDim Preserve arrData(1 To 1, 1 To Cnt)
arrData(1, Cnt) = olMail.ReceivedTime
ws.Cells(1, 1).Value = arrData(1, Cnt) 'use ws here as well if same Sheet1
ws.Cells(1, 1).NumberFormat = "dd/mm/yyyy hh:mm:ss AM/PM"
olMail.Move olNS.GetDefaultFolder(6).Folders("Processed") 'change to olMail as well
Cnt = Cnt + 1
Next
This is untested so i leave the testing to you. :)