[Solved] How to copy Outlook mail message into excel using Macros

by


I think this should pretty much do what you want.

Sub Extract()
 On Error Resume Next
 Set myOlApp = Outlook.Application
 Set mynamespace = myOlApp.GetNamespace("mapi")
 Set myfolder = myOlApp.ActiveExplorer.CurrentFolder

Set xlobj = CreateObject("excel.application.14")
 xlobj.Visible = True
 xlobj.Workbooks.Add
 xlobj.Worksheets("Sheet1").Name = "Statusmail"

'Set the header
 xlobj.Range("a" & 1).Value = "Absender"
 xlobj.Range("a" & 1).Font.Bold = "True"
 xlobj.Range("b" & 1).Value = "Date"
 xlobj.Range("b" & 1).Font.Bold = "True"
 xlobj.Range("c" & 1).Value = "Task"
 xlobj.Range("c" & 1).Font.Bold = True
 xlobj.Range("d" & 1).Value = "Planed-date"
 xlobj.Range("d" & 1).Font.Bold = True
 xlobj.Range("e" & 1).Value = "deadline"
 xlobj.Range("e" & 1).Font.Bold = True
 xlobj.Range("f" & 1).Value = "finished"
 xlobj.Range("f" & 1).Font.Bold = True
 xlobj.Range("g" & 1).Value = "time effort"
 xlobj.Range("g" & 1).Font.Bold = True
 xlobj.Range("h" & 1).Value = "description"
 xlobj.Range("h" & 1).Font.Bold = True

For i = 1 To myfolder.Items.Count
  Set myitem = myfolder.Items(i)
  msgtext = myitem.Body

  xlobj.Range("a" & i + 1).Value = myitem.To
  xlobj.Range("b" & i + 1).Value = myitem.ReceivedTime
  xlobj.Range("c" & i + 1).Value = msgtext


 Next
 End Sub

0

solved How to copy Outlook mail message into excel using Macros