ファイル一覧を取得する

2012/12/21

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