I don't have code handy, but this is a start - (taken from a macro another user posted in recent days) - it needs coded to work on a folder or selection of messages and get the attachment names. I won't have time before the week end to put anything together though.
Option Explicit
Sub CopyToExcel()
Dim olItem As Outlook.MailItem
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim vText As Variant
Dim sText As String
Dim vItem As Variant
Dim i As Long
Dim rCount As Long
Const strPath As String = "C:\Users\username\Documents\test.xlsx" 'the path of the workbook
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Test")
' Process the message record
Set olItem = Application.ActiveExplorer().Selection(1)
'Find the next empty line of the worksheet
rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(-4162).Row
rCount = rCount + 1
' add code to get attachment names here
' assign to vText variable.
xlSheet.Range("B" & rCount) = vText
xlWB.Close 1
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
End Sub