投稿‎ > ‎

VBAで遊ぼう⑦

posted Mar 22, 2016, 9:52 PM by Zhang Wenxu
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
Comments