Body of outlook email does not copy to excel - excel

Question

The following code works It will open up designated file from designated email. However it will not Seperate the body message into different line in excel, any suggestions?
For i = LBound(MyAr) To UBound(MyAr)
'~~> This will give you the contents of your email
'~~> on separate lines
Debug.Print MyAr(i)
Next i
End With
Const xlUp As Long = -4162
Sub ExportToExcel(MyMail As MailItem)
Dim strID As String, olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim strFileName As String
'~~> Excel Variables
Dim oXLApp As Object, oXLwb As Object, oXLws As Object
Dim lRow As Long
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)
'~~> Establish an EXCEL application object
On Error Resume Next
Set oXLApp = GetObject(, "Excel.Application")
'~~> If not found then create new instance
If Err.Number <> 0 Then
Set oXLApp = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo 0
'~~> Show Excel
oXLApp.Visible = True
'~~> Open the relevant file
Set oXLwb = oXLApp.Workbooks.Open("C:\Users\ltorres\Documents\multiplier.xlsx")
'~~> Set the relevant output sheet. Change as applicable
Set oXLws = oXLwb.Sheets("Sheet1")
lRow = oXLws.Range("A" & oXLws.Rows.Count).End(xlUp).Row + 1
'~~> Write to outlook
With oXLws
Dim MyAr() As String
MyAr = Split(olMail.Body, vbCrLf)
For i = LBound(MyAr) To UBound(MyAr)
'~~> This will give you the contents of your email
'~~> on separate lines
Debug.Print MyAr(i)
Next i
End With
'~~> Close and Clean up Excel
oXLwb.Close (True)
oXLApp.Quit
Set oXLws = Nothing
Set oXLwb = Nothing
Set oXLApp = Nothing
Set olMail = Nothing
Set olNS = Nothing
End Sub

Answer 1

You can set lRow in the With statement, but you also need to add 1 row each time there is a line break as defined by your MyAr, try:
With oXLws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
Dim MyAr() As String
MyAr = Split(olMail.Body, vbCrLf)
For i = LBound(MyAr) To UBound(MyAr)
.Range("A" & lRow).Value = MyAr(i)
lRow = lRow + 1
Next i
End With