Sub getpath() Range("A2:D1000").ClearContents On Error Resume Next Dim shell As Variant Set shell = CreateObject("Shell.Application") Set filePath = shell.BrowseForFolder(&O0, "选择文件夹", &H1 + &H10, "") '获取文件夹路径地址 Set shell = Nothing If filePath Is Nothing Then Exit Sub Else gg = filePath.Items.Item.Path End If Set obj = CreateObject("Scripting.FileSystemObject") Set fld = obj.getfolder(gg) For Each ff In fld.Files m = m + 1 Cells(m + 1, 1) = ff.name Cells(m + 1, 2) = ff.Path Cells(m + 1, 3) = ff.Size Cells(m + 1, 4) = ff.DateCreated Next End Sub |
|