Код: Выделить всё
Private Sub Test()
Dim objNameSpace As Outlook.NameSpace
Dim objFolderInbox As Outlook.MAPIFolder
Dim objItems As Outlook.Items
'Dim objItem As Outlook.MailItem
Dim iCount&, iCounter&, iArraySubject$()
Set objNameSpace = Application.GetNamespace("MAPI")
Set objFolderInbox = objNameSpace.GetDefaultFolder(olFolderInbox)
Set objItems = objFolderInbox.Items
iCount = objItems.Count
If iCount > 0 Then
ReDim iArraySubject(1 To iCount, 1 To 1)
For iCounter = 1 To iCount
iArraySubject(iCounter, 1) = objItems(iCounter).Subject
Next
With CreateObject("Excel.Application")
With .Workbooks.Add.Worksheets(1)
.Range("A1").Resize(iCount) = iArraySubject
End With
.Visible = True
End With
End If
End Sub