Trying to creating a macro that will copy my email to a new excel workbook that will keep the format of the body of the email. all the macro's im finding are putting the body in one cell. i need the body in a table that was provided in the email with all the column and headers. below is what the headers are with a few records. for some reason they are unable to send me the file in excel. all the headers are in one word. im currenty using the code below, but it puts the body all in one cell.
this is in outlook 2010 and excel 2010
1-15-2013 3-51-10 PM.png
Sub ReadAndSaveDetails()
'This routine will read each of the selected emails and then update those values to a Workbook
Dim myItem As Object
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim myExcelApp As Excel.Application
Dim myWorkbook As Excel.Workbook
Dim myRange As Range
Dim i As Integer
'Work on Selected Items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
'Create an Excel Application
Set myExcelApp = CreateObject("Excel.Application")
myExcelApp.Application.Visible = True
'Now Open the Workbook for Update
myExcelApp.Workbooks.Open FileName:="c:\temp\Test Workbook.xls"
Set myWorkbook = myExcelApp.ActiveWorkbook
'First lets set the range for the Workbook ready to take the new values
Set myRange = myWorkbook.Worksheets("Sheet1").Range("A1")
i = 1
'Now for each Item
For Each myItem In myOlSel
myRange.Offset(i, 0).Value = myItem.SentOn
myRange.Offset(i, 1).Value = myItem.Subject
myRange.Offset(i, 2).Value = myItem.Body
myRange.Offset(i, 3).Value = myItem.SenderEmailAddress
i = i + 1
'MsgBox "Email Details – " & myItem.SentOn & vbNewLine & myItem.Subject & vbNewLine & myItem.Body
Next
myWorkbook.Close SaveChanges:=True
myExcelApp.Quit
Set myWorkbook = Nothing
Set myExcelApp = Nothing
'Free Storage
Set myItem = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
End Sub
Bookmarks