Option Explicit
Private Sub CommandButton1_Click()
Dim Shell, myPath, strPath, i
i = 2
Set Shell = CreateObject("Shell.Application")
Set myPath = Shell.BrowseForFolder(&O0, "フォルダを選んでください", &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 strShtName, objFs, objFld, objFl, objSub
Set objFs = CreateObject("Scripting.FileSystemObject")
Set objFld = objFs.GetFolder(strPath)
Set strShtName = ActiveSheet
For Each objFl In objFld.Files
strShtName.Cells(i, 2) = objFs.GetFileName(objFl.Path)
strShtName.Cells(i, 3) = objFl.ParentFolder.Path
strShtName.Cells(i, 4) = Int(objFl.Size / 1024)
strShtName.Cells(i, 5) = objFl.Type
strShtName.Cells(i, 6) = objFl.DateLastModified
i = i + 1
Next
For Each objSub In objFld.SubFolders
ListFiles objSub.Path, i
Next
End Sub
|