Option Explicit
Private Sub CommandButton1_Click()
Dim Shell, myPath, strPath, i
i = 2
Set Shell = CreateObject("Shell.Application")
Set myPath = Shell.BrowseForFolder(&O0, "Select a folder", &H1 + &H10, "")
If myPath Is Nothing Then Exit Sub
strPath = myPath.Items.Item.Path
Range("A" & i, ActiveCell.SpecialCells(xlLastCell)).ClearContents
ListFiles strPath, i
End Sub
Private Sub ListFiles(strPath, i)
Dim objFs, objFld, objFl, strShtName, P_Path, FileNam
Set objFs = CreateObject("Scripting.FileSystemObject")
Set objFld = objFs.GetFolder(strPath)
Set strShtName = ActiveSheet
For Each objFl In objFld.Files
P_Path = objFl.ParentFolder.Path
FileNam = objFs.GetFileName(objFl.Path)
strShtName.Cells(i, 2) = FileNam
strShtName.Cells(i, 3) = ExecuteExcel4Macro("'" & P_Path & "\[" & FileNam & "]Sheet1'!R2C2")
i = i + 1
Next
End Sub
|