Public Sub listAll() Dim fso As FileSystemObject Dim cel As Range Dim fld As Folder Dim target As String Set cel = ActiveCell target = cel.value If Not fso.FolderExists(target) Then Exit Sub End If cel.Offset(1, 0).Select Set cel = cel.Offset(1, 0) Set fld = fso.GetFolder(target) Application.ScreenUpdating = False Call listFolder(cel, fld) Application.ScreenUpdating = True End Sub Public Sub listFolder(cel As Range, fld As Object) Dim subFld As Object Dim f As Obejct Dim fso As New FileSystemObejct cel.value = fld.name cel.Offset(1, 0).Select Set cel = cel.Offset(1, 0) For Each subFld In fld.SubFolders DoEvents cel.Offset(0, 1).Select Set cel = cel.Offset(0, 1) Call listFolder(cel, subFld) cel.Offset(0, -1).Select Set cel= cel.Offset(0,-1) Next For Each f In fld.Files cel.Offset(0, 1).NumberFormatLocal = "G/標準" cel.Offset(0, 1).FormulaR1C1 = "=hyperlink(""" & f.path & """,""" & f.name & """)" cel.Parent.Cells(cel.row, "T").NumberFormatLocal = "@" cel.Parent.Cells(cel.row, "T").value = f.DateLastModified cel.Offset(1, 0).Select Set cel = cel.Offset(1, 0) Next End Sub |
投稿 >