copy outlook body into excel without leaving column space

[SamSan78]

Hello,

my object is to copy information from an email body into excel. the email has the data in different lines which needs to be updated in an excel file exactly in the same order.

i have the following code which is doing that however it is leaving one column blank for every carrage return from the email

the information in email is like the following

this is me
this is my test
this is my result

the above needs to be put into column A,B, and c of the worksheet, however it saves in column A,C,E

please help

Dim wb As Workbook Dim wks As Worksheet Dim ObjOutlook As Object Dim MyNamespace As Object Dim i As Integer Dim j As Long Dim abody() As String Dim rstart As Range Set wb = Workbooks.Open("C:\Users\s213581\Documents\Test\EmailBody.xlsx") Set wks = wb.Worksheets("Test") Set ObjOutlook = GetObject(, "Outlook.Application") Set MyNamespace = ObjOutlook.GetNamespace("MAPI") For i = 1 To MyNamespace.GetDefaultFolder(6).Folders("HQ Dashboard").Items.Count abody = Split(MyNamespace.GetDefaultFolder(6).Folders("HQ Dashboard").Items(i).Body, Chr(13) & Chr(10)) Set rstart = wks.Cells(65000, 1).End(xlUp).Offset(1, 0) For j = 0 To UBound(abody) If Len(abody(j)) > 1 Then rstart.Offset(0, j).Value = abody(j) End If Next j Next i wb.Close True

 

[John_w]

Welcome to MrExcel forums - but please use VBA code tags.

Try replacing the For j .... Next j loop with:

  Dim colOffset As Long
  colOffset = 0
  For j = 0 To UBound(abody)
    If Len(abody(j)) > 1 Then
      rstart.Offset(0, colOffset).Value = abody(j)
      colOffset = colOffset + 1
    End If
  Next j

 

[SamSan78]

Thank u very much.