MSG files

[exandbeyond]

Operating System:
Microsoft XP
Applications:
Excel 2007
Outlook 2007


I am trying to write a macro that would extract the data from selected msg file(s) within a folder and paste the data in to the next available row. I already have an existing workbook with data on it.

It should look like this when done:

A1	B2	C2	D3	E3	F3
Date Received	From	Department	Subject	Attachment #1	Attachment #2

<TBODY>
</TBODY>

You can get the department by clicking on the person's name causing a new message box to open. Those who work or have worked in organizations that have an address book directory should know what I am talking about because I am not sure what its called.

I don't know how many attachements the email will have so I need it to keep adding columns for all the atttachments.


This is what I have so far:

 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")
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

Hope I can I can get some help for this. Thanks in advance

Cliffs: I have a ton of msg files saved and I need to put the data from those files into a spreadsheet.

 

[exandbeyond]

I made a mistake on how the data should look like. It should look like this.

A1	B1	C1	D1	E1	F1
Date Received	From	Department	Subject	Attachment #1	Attachment #2

<TBODY>
</TBODY>