Help us understand the problem. What is going on with this article?


Option Explicit

Sub ファイル一覧生成()


Call setFileList(ThisWorkbook.Path)

End Sub

Sub setFileList(searchPath)

Dim startCell As Range
Dim maxRow As Long
Dim maxCol As Long

Set startCell = Cells(2, 1)

maxRow = startCell.SpecialCells(xlLastCell).Row
maxCol = startCell.SpecialCells(xlLastCell).Column
Range(startCell, Cells(maxRow, maxCol)).ClearContents

Call getFileList(searchPath)


End Sub

Sub getFileList(searchPath)

Dim FSO As New FileSystemObject
Dim objFiles As File
Dim objFolders As Folder
Dim separateNum As Long

Dim cur_BookName, fpath, fname

cur_BookName = ActiveWorkbook.Name

For Each objFolders In FSO.GetFolder(searchPath).SubFolders
    Call getFileList(objFolders.Path)

For Each objFiles In FSO.GetFolder(searchPath).Files

    separateNum = InStrRev(objFiles.Path, "\")

    fpath = Left(objFiles.Path, separateNum - 1)
    fname = Right(objFiles.Path, Len(objFiles.Path) - separateNum)

    If cur_BookName <> fname And "~$" & cur_BookName <> fname Then

        ActiveCell.Value = fpath
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=fpath, TextToDisplay:=fpath

        ActiveCell.Offset(0, 1).Value = objFiles.Name

        ActiveCell.Offset(0, 2).Value = objFiles.Type
        ActiveCell.Offset(0, 3).Value = objFiles.DateCreated
        ActiveCell.Offset(0, 4).Value = objFiles.DateLastModified
        ActiveCell.Offset(0, 5).Value = Format((FileLen(objFiles) / 1024), "#.0")

        ActiveCell.Offset(0, 1).Select
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=fpath & "\" & fname, TextToDisplay:=fname

        ActiveCell.Offset(1, -1).Select

    End If


End Sub

Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away