Body of Outlook E-Mail kopiert nicht nach Excel

Question

Der folgende Code funktioniert Es wird die angegebene Datei von designierter E-Mail öffnen. Jedoch wird es die Körpermitteilung in andere Linie in Excel, irgendwelche Vorschläge nicht trennen?

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

Sie lRow in der With Anweisung festlegen können, aber Sie müssen auch 1 Zeile jedes Mal hinzuzufügen, da ein Zeilenumbruch ist, wie von Ihrem definiert, versuchen :

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