フォルダ内再帰検索するマクロ
2021年05月26日
フォルダ内のCSVファイルについて、サブフォルダを含めて全部中身を書き出したい。
ということで、ネットで調べて再帰検索するマクロを移植。
'http://blog.jmiri.net/?p=1763
シート選択で動かすと確かにシンプルになるものの、
処理速度が圧倒的に不利。
できれば直したいけど、一発ものだから様子見。
ファイルサイズと更新日時は、ファイル名に環境依存文字があると動かないので
FSOで取得するように改良。
全フォルダをなめる処理は完成。
過去に作った再帰なしのファイルの中身を書き出すマクロと
がっちゃんこして完成かな。
以下、ソース（途中）
ということで、ネットで調べて再帰検索するマクロを移植。
'http://blog.jmiri.net/?p=1763
シート選択で動かすと確かにシンプルになるものの、
処理速度が圧倒的に不利。
できれば直したいけど、一発ものだから様子見。
ファイルサイズと更新日時は、ファイル名に環境依存文字があると動かないので
FSOで取得するように改良。
全フォルダをなめる処理は完成。
過去に作った再帰なしのファイルの中身を書き出すマクロと
がっちゃんこして完成かな。
以下、ソース（途中）
Option Explicit
Const TarExt = ".txt"
'http://blog.jmiri.net/?p=1763
Sub setFileList(searchPath)
Dim startCell As Range
Dim maxRow As Long
Dim maxCol As Long
Worksheets("ファイル").Select
Set startCell = Cells(5, 2) 'このセルから出力し始める
startCell.Select
'シートをいったんクリア
maxRow = startCell.SpecialCells(xlLastCell).Row
maxCol = startCell.SpecialCells(xlLastCell).Column
Range(startCell, Cells(maxRow, maxCol)).ClearContents
Call getFileList(searchPath)
startCell.Select
End Sub
Sub getFileList(searchPath)
Dim FSO As Object, tmpSize, tmpDate
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim objFiles
Dim objFolders
Dim separateNum As Long
'サブフォルダ取得
For Each objFolders In FSO.GetFolder(searchPath).SubFolders
Call getFileList(objFolders.Path)
Next
'ファイル名の取得
For Each objFiles In FSO.GetFolder(searchPath).Files
If Right(objFiles, Len(TarExt)) = TarExt Then
separateNum = InStrRev(objFiles.Path, "\")
'セルにパスとファイル名を書き込む
tmpSize = FSO.GetFile(objFiles).Size
tmpDate = FSO.GetFile(objFiles).DateLastModified
ActiveCell.Value = Left(objFiles.Path, separateNum - 1)
ActiveCell.Offset(0, 1).Value = Right(objFiles.Path, Len(objFiles.Path) - separateNum)
ActiveCell.Offset(0, 2).Value = tmpDate
ActiveCell.Offset(0, 3).Value = Format((tmpSize / 1024), "#.0")
Call テキストの中身を書き出す
ActiveCell.Offset(1, 0).Select
End If
Next
End Sub
Sub テキストの中身を書き出す()
End Sub
PR
Comment