Extract data from .msg files into excel

[Abhijeet]

Hi

I have 500 .msg files i want to pull Subject, Body,Email Id From, Email Id To,

Please tell me how to do this

I have macro but that macro pull only Subject line please tell me rest data how to pull in excel

Option Explicit
Sub GetSubjectLines()
    Dim olA As Object
    Dim aPaths() As String 'paths to *.msg files
    Dim vSubjects() As Variant 'list of subjects
    Dim vSelItems As Variant 'to get selected items
    Dim i As Long
    Dim rDest As Range 'where Subject lines will be written
Set olA = CreateObject("Outlook.Application")
Set rDest = Range("B1")
'Select the files to process
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Filters.Add "Messages", "*.msg", 1
    .FilterIndex = 1
    If .Show = -1 Then
        ReDim aPaths(0 To .SelectedItems.Count - 1)
        For i = 0 To .SelectedItems.Count - 1
            aPaths(i) = .SelectedItems(i + 1)
        Next i
    End If
End With
Application.ScreenUpdating = False
rDest.EntireColumn.Clear
With rDest(1, 1)
    .Value = "Subjects"
    .Font.Bold = True
End With
ReDim vSubjects(1 To UBound(aPaths) + 1, 1 To 1)
For i = 0 To UBound(aPaths)
    vSubjects(i + 1, 1) = olA.CreateItemFromTemplate(aPaths(i)).Subject
Next i
Set rDest = rDest.Offset(rowoffset:=1).Resize(rowsize:=UBound(vSubjects))
rDest = vSubjects
rDest.EntireColumn.AutoFit
Application.ScreenUpdating = True
Set olA = Nothing
End Sub

 

[Abhijeet]

Please help me how to pull mail body as well in this macro

 

[Abhijeet]

Hi

I tried this & able to do Body part in macro but i am stuck to add attachments part can any one tell me how to add this in VBA

ReDim vSubjects(1 To UBound(aPaths) + 1, 1 To 1)
ReDim vbody(1 To UBound(aPaths) + 1, 1 To 1)
For i = 0 To UBound(aPaths)
    vSubjects(i + 1, 1) = olA.CreateItemFromTemplate(aPaths(i)).Subject
    vbody(i + 1, 1) = olA.CreateItemFromTemplate(aPaths(i)).body
Next i
Set rDest = rDest.Offset(rowoffset:=1).Resize(rowsize:=UBound(vSubjects))
Set rdest2 = rdest2.Offset(rowoffset:=1).Resize(rowsize:=UBound(vbody))
rDest = vSubjects
rdest2 = vbody

 

[Abhijeet]

Can you Please tell me how to do this for attachment part