Outlook电子邮件的身体不复制到Excel

下面的代码工作它将从指定的电子邮件打开指定的文件。 但是不会将excel中的正文消息分隔成不同的行，有什么build议吗？

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 

结束小组

Answer 1

你可以在With语句中设置lRow ，但是每次MyAr定义的MyAr ，还需要添加1行，请尝试：

 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