The below code works GREAT -- WITHOUT the 3 <<<THIS IS NEW LINE
That appear below. I'm wanting to extract the text that is in
The Workbook.Properties Dialog box - Subject Line (2) and have it
Placed in the cell to the right of the File Name.

Right Now I'm getting a Compile Error - Invalid Qualifier. ?? to me..
Any assistance appreciated.

Sub ListFiles(sFolder As String)
Dim wks As Worksheet
Dim lRowIndex As Long
Dim NumFiles As Long

Dim fso As FileSystemObject
Set fso = New FileSystemObject
'Either set a reference to Microsoft Scripting Runtime (Tools
References)
'or uncomment following two lines and comment previous two.
'Dim fso As Object
'Set fso = CreateObject("Scripting.FileSystemObject")

Dim fsoFiles As Files
Dim fsoFile As File
Dim fname As String
Dim fSubject As String <<<<< THIS IS NEW LINE
Application.ScreenUpdating = False
Set fsoFiles = fso.GetFolder(sFolder).Files

lRowIndex = 0
Set wks = Sheets.Add
For Each fsoFile In fsoFiles
fname = fsoFile.Name
fSubject = fname.BuiltinDocumentProperties(2) <<< THIS IS NEW
LINE
If LCase(fso.GetExtensionName(fname)) = "xls" Then
lRowIndex = lRowIndex + 1
wks.Cells(lRowIndex, 1).Value = fname
wks.Cells(lRowIndex, 2).Value = fSubject <<<< THIS IS NEW LINE
End If
If lRowIndex wks.Rows.Count Then Exit For
Next
Selection.CurrentRegion.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Copy
Sheets("Sheet1").Select
Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
NumFiles = Range("B65536").End(xlUp).Row - 4
Range("A1").Value = NumFiles
Range("C1").Value = Now()
Range("B5").Select
Application.CutCopyMode = False
Application.DisplayAlerts = False
Sheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub