Macro que exporta mensaje de un correo outlook a excel

Es una macro que importa mensajes de correo de outlook a excel pero el problema que tengo es que el contenido del mensaje me lo guarda en una sola celda y no en celdas definidas como puedo hacer que el contenido del mensaje se guarde en celdas definidas?

Option Explicit

Public Sub CopyEmailToExcelWhenArrive(olItem As Outlook.MailItem)

Dim xlApp As Object

Dim xlWB As Object

Dim xlSheet As Object D

im rCount As Long

Dim bXStarted As Boolean

Dim enviro As String

Dim strPath As String

Dim iDefault As Long

'Declare registry

Dim sKey As String

Dim lRegValue As Long

Dim sAppName As String

Dim sSection As String

'Set name of registry keys

sAppName = "Outlook"

sSection = "received" s

Key = "Current Value Number XLS"

iDefault = 2

lRegValue = GetSetting(sAppName, sSection, sKey, iDefault)

Dim currentExplorer As Explorer

Dim Selection As Selection

Dim obj As Object

Dim strColB, strColC, strColD, strColE As String

' Get Excel set up

'the path of the workbook

strPath = "C:\1-Tests\test.xlsx"

On Error Resume Next

Set xlApp = GetObject(, "Excel.Application")

If Err <> 0 Then

Application.StatusBar = "Please wait while Excel source is opened ... "

Set xlApp = CreateObject("Excel.Application")

bXStarted = True

End If

On Error GoTo 0

'Open the workbook to input the data

Set xlWB = xlApp.Workbooks.Open(strPath)

Set xlSheet = xlWB.Sheets("Test")

' Process the message record

On Error Resume Next

'collect the fields

strColE = olItem.Body

'write them in the excel sheet

xlSheet.Range("e" & lRegValue) = strColE

'Save registry row increment

SaveSetting sAppName, sSection, sKey, lRegValue + 1

xlWB.Close 1

If bXStarted Then

xlApp.Quit

End If

Set olItem = Nothing

Set obj = Nothing

Set currentExplorer = Nothing

Set xlApp = Nothing

Set xlWB = Nothing

Set xlSheet = Nothing

End Sub