'フォルダ内のXLSファイルの一覧を作成するマクロ

Option Explicit

'アクティブブックと同じフォルダにあるXLSファイルの一覧を
'Sheet1のA列に作成するマクロ

'Sheet1のA列はクリアされます。
'アクティブブック名も一覧に含まれます。

Sub DirXLS()
    Dim iRet As Integer
    Sheets("Sheet1").Columns(1).ClearContents
    iRet = DirToRange(ActiveWorkbook.Path, "*.XLS", _
        Sheets("Sheet1").Range("A1"))
    If iRet < 0 Then
        MsgBox "エラーが発生しました。", vbExclamation
    Else
        MsgBox CStr(iRet) & "個のファイルが見つかりました。", vbInformation
    End If
End Sub

Function DirToRange(ByVal sPath As String, _
        ByVal sFileFilter As String, _
        ByVal oRange_Output As Range) As Integer
    Dim iCount As Integer
    Dim sFileName As String

    DirToRange = -1
    On Error GoTo ErrorHandler

    If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
    iCount = 0
    sFileName = Dir$(sPath & sFileFilter)
    Do While sFileName <> ""
        iCount = iCount + 1
        oRange_Output.Cells(iCount, 1).Value = "'" & sFileName
        sFileName = Dir$()
    Loop
    DirToRange = iCount
    Exit Function
ErrorHandler:
End Function