JuniorASA
01-20-2007, 08:57 AM
I would like to extract all excel file's names from particular files. 
Is there any way I could extract all excel file's names into excel spreadsheet by excel macro?
Bob Phillips
01-20-2007, 10:17 AM
Option Explicit
Dim FSO As Object
Dim cnt As Long
Dim arfiles
Dim level As Long
Sub Folders()
Dim i As Long
Dim sFolder As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    arfiles = Array()
    cnt = -1
    level = 1
    sFolder = "C:\myTest"
    ReDim arfiles(1, 0)
    If sFolder <> "" Then
        SelectFiles sFolder
        Worksheets.Add.Name = "Files"
        With ActiveSheet
            For i = LBound(arfiles, 2) To UBound(arfiles, 2)
                    .Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(1, i)), _
                                    Address:=arfiles(0, i), _
                                    TextToDisplay:=arfiles(0, i)
            Next
            .Columns("A:Z").EntireColumn.AutoFit
        End With
    End If
End Sub
'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object
    If sPath = "" Then
        Set FSO = CreateObject("SCripting.FileSystemObject")
        sPath = "c:\myTest"
    End If
    Set Folder = FSO.GetFolder(sPath)
    Set Files = Folder.Files
    For Each file In Files
        If Right(file, 4) = ".xls" Then
            cnt = cnt + 1
            ReDim Preserve arfiles(1, cnt)
            arfiles(0, cnt) = Folder.Path & "\" & file.Name
            arfiles(1, cnt) = level
        End If
    Next file
    level = level + 1
    For Each fldr In Folder.Subfolders
        SelectFiles fldr.Path
    Next
End Sub
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.