VBA에서 폴더 트리의 파일 수를 일괄 적으로 검사
보통은 Explorer에서 직접 폴더를 보러 갑니다만, 트리의 가지가 많으면 번거롭고, 메모하지 않으면 점점 모르게 되어 옵니다. . .
프리 소프트웨어를 설치하지 않아도 간이적으로 조사할 수 있도록 매크로를 만들어 보았습니다.
코드
CountFilesInSubDir.basOption Explicit
Public Const ADR_ROOT As String = "B2" ' ルートフォルダ格納セル(controlシート)
Public Const ADR_FOL_ROOT As String = "B2" ' ルートフォルダ格納セル(resultsシート)
Public Const ADR_ST_CNT As String = "A5" ' カウント結果格納開始セル(resultsシート)
Public Const SHT_CTRL As String = "control" ' controlシート
Public Const SHT_RSLT As String = "results" ' resultsシート(結果出力シート)
Public rPath As String ' ルートフォルダパス
Public sep As String ' パス区切り記号(\)
Public target As String ' カウント対象ファイル種類
Public cnt As Integer ' 対象ファイル数
Public ofstRow As Integer ' resultsシートインクリメント用変数
Sub CountFilesInSubDir()
'*****************************************************
' メインメソッド
'*****************************************************
Dim csh, rsh As Object
Dim stAdd, enRsltAdd As String
Set csh = Sheets(SHT_CTRL)
Set rsh = Sheets(SHT_RSLT)
stAdd = ADR_ST_CNT
rPath = csh.Range(ADR_ROOT).Value
target = csh.Range(ADR_ROOT).Offset(1, 0).Value
sep = Application.PathSeparator
ofstRow = 0
rsh.Range(ADR_FOL_ROOT).Value = rPath
rsh.Range(ADR_FOL_ROOT).Offset(1, 0).Value = target
enRsltAdd = rsh.Cells.SpecialCells(xlCellTypeLastCell).Address(False, False, xlA1)
rsh.Range(ADR_ST_CNT & ":" & enRsltAdd).ClearContents
'---- サブフォルダ検索
Call SearchSubFolder(rPath)
End Sub
Sub SearchSubFolder(Path As String)
'*****************************************************
' サブフォルダを再帰的に検索するメソッド
'*****************************************************
Dim buf As String
Dim f, rsh As Object
Set rsh = Sheets(SHT_RSLT)
'---- フォルダ内検索
buf = Dir(Path & sep & target)
Do While buf <> ""
cnt = cnt + 1
buf = Dir()
Loop
'---- 結果出力
With rsh.Range(ADR_ST_CNT)
.Offset(ofstRow, 0).Value = cnt
If Path = rPath Then
.Offset(ofstRow, 1).Value = "(ルートフォルダ)"
Else
.Offset(ofstRow, 1).Value = Replace(Path, rPath & sep, "")
End If
If cnt > 0 Then
'---- ファイルがある場合、フォルダへのリンク挿入
rsh.Hyperlinks.Add _
anchor:=.Offset(ofstRow, 1), _
Address:=Path
End If
End With
ofstRow = ofstRow + 1
'---- サブフォルダ検索(再帰処理)
With CreateObject("Scripting.FileSystemObject")
cnt = 0
For Each f In .GetFolder(Path).SubFolders
Call SearchSubFolder(f.Path)
Next f
End With
End Sub
Sub SelectFolder()
'*****************************************************
' ルートフォルダを選択するメソッド
'*****************************************************
Dim csh As Object
Set csh = Sheets(SHT_CTRL)
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
csh.Range(ADR_ROOT).Value = .SelectedItems(1)
Else
Exit Sub
End If
End With
End Sub
Excel 시트
Option Explicit
Public Const ADR_ROOT As String = "B2" ' ルートフォルダ格納セル(controlシート)
Public Const ADR_FOL_ROOT As String = "B2" ' ルートフォルダ格納セル(resultsシート)
Public Const ADR_ST_CNT As String = "A5" ' カウント結果格納開始セル(resultsシート)
Public Const SHT_CTRL As String = "control" ' controlシート
Public Const SHT_RSLT As String = "results" ' resultsシート(結果出力シート)
Public rPath As String ' ルートフォルダパス
Public sep As String ' パス区切り記号(\)
Public target As String ' カウント対象ファイル種類
Public cnt As Integer ' 対象ファイル数
Public ofstRow As Integer ' resultsシートインクリメント用変数
Sub CountFilesInSubDir()
'*****************************************************
' メインメソッド
'*****************************************************
Dim csh, rsh As Object
Dim stAdd, enRsltAdd As String
Set csh = Sheets(SHT_CTRL)
Set rsh = Sheets(SHT_RSLT)
stAdd = ADR_ST_CNT
rPath = csh.Range(ADR_ROOT).Value
target = csh.Range(ADR_ROOT).Offset(1, 0).Value
sep = Application.PathSeparator
ofstRow = 0
rsh.Range(ADR_FOL_ROOT).Value = rPath
rsh.Range(ADR_FOL_ROOT).Offset(1, 0).Value = target
enRsltAdd = rsh.Cells.SpecialCells(xlCellTypeLastCell).Address(False, False, xlA1)
rsh.Range(ADR_ST_CNT & ":" & enRsltAdd).ClearContents
'---- サブフォルダ検索
Call SearchSubFolder(rPath)
End Sub
Sub SearchSubFolder(Path As String)
'*****************************************************
' サブフォルダを再帰的に検索するメソッド
'*****************************************************
Dim buf As String
Dim f, rsh As Object
Set rsh = Sheets(SHT_RSLT)
'---- フォルダ内検索
buf = Dir(Path & sep & target)
Do While buf <> ""
cnt = cnt + 1
buf = Dir()
Loop
'---- 結果出力
With rsh.Range(ADR_ST_CNT)
.Offset(ofstRow, 0).Value = cnt
If Path = rPath Then
.Offset(ofstRow, 1).Value = "(ルートフォルダ)"
Else
.Offset(ofstRow, 1).Value = Replace(Path, rPath & sep, "")
End If
If cnt > 0 Then
'---- ファイルがある場合、フォルダへのリンク挿入
rsh.Hyperlinks.Add _
anchor:=.Offset(ofstRow, 1), _
Address:=Path
End If
End With
ofstRow = ofstRow + 1
'---- サブフォルダ検索(再帰処理)
With CreateObject("Scripting.FileSystemObject")
cnt = 0
For Each f In .GetFolder(Path).SubFolders
Call SearchSubFolder(f.Path)
Next f
End With
End Sub
Sub SelectFolder()
'*****************************************************
' ルートフォルダを選択するメソッド
'*****************************************************
Dim csh As Object
Set csh = Sheets(SHT_CTRL)
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
csh.Range(ADR_ROOT).Value = .SelectedItems(1)
Else
Exit Sub
End If
End With
End Sub
이전 준비
実行
버튼과 ...
버튼을 작성해, 実行
버튼에 CountFilesInSubDir, ...
버튼에 SelectFolder를 등록한다. 사용방법
→results 시트에 각 폴더의 카운트 결과가 출력됩니다. 파일이 있으면 폴더에 대한 링크가 삽입됩니다.
해설
작성의 동기는 단순히 폴더내의 파일이 몇개인가를 알고 싶었다고 하는 것이므로, 파일명 일람 표시 기능은 구현하고 있지 않습니다. 폴더에 링크를 삽입했으므로 링크를 누르면 해당 폴더가 열리고 내용을 확인할 수 있습니다. (수수하게 편리할지도!와 자화 자찬...)
참조 사이트
VBA 매크로 셀에 하이퍼링크 설정(자기롭게 Excel VBA)
하위 폴더를 포함하여 파일 목록 가져오기(Dir 함수 재귀 호출)
Reference
이 문제에 관하여(VBA에서 폴더 트리의 파일 수를 일괄 적으로 검사), 우리는 이곳에서 더 많은 자료를 발견하고 링크를 클릭하여 보았다
https://qiita.com/Qiitacky/items/88bd63e592ff094f43d1
텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
우수한 개발자 콘텐츠 발견에 전념
(Collection and Share based on the CC Protocol.)
VBA 매크로 셀에 하이퍼링크 설정(자기롭게 Excel VBA)
하위 폴더를 포함하여 파일 목록 가져오기(Dir 함수 재귀 호출)
Reference
이 문제에 관하여(VBA에서 폴더 트리의 파일 수를 일괄 적으로 검사), 우리는 이곳에서 더 많은 자료를 발견하고 링크를 클릭하여 보았다 https://qiita.com/Qiitacky/items/88bd63e592ff094f43d1텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
우수한 개발자 콘텐츠 발견에 전념 (Collection and Share based on the CC Protocol.)