VBA에서 폴더 트리의 파일 수를 일괄 적으로 검사

14689 단어 VBAExcel
폴더 트리의 하위 폴더에 .xlsx, .txt 등의 데이터가 있는지, 몇 개 포함되어 있는지를 단번에 알고 싶을 때 없습니까?
보통은 Explorer에서 직접 폴더를 보러 갑니다만, 트리의 가지가 많으면 번거롭고, 메모하지 않으면 점점 모르게 되어 옵니다. . .
프리 소프트웨어를 설치하지 않아도 간이적으로 조사할 수 있도록 매크로를 만들어 보았습니다.

코드



CountFilesInSubDir.bas
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

Excel 시트


  • control 시트

  • 결과 시트 (결과 출력 시트)


  • 이전 준비


  • 임의 이름의 .xlsm을 만들고 "control", "results"시트를 만듭니다. (시트 내 설정에 대한 자세한 내용은 이미지 참조)
  • 코드를 표준 모듈에 붙여넣습니다.
  • control 시트에 実行 버튼과 ... 버튼을 작성해, 実行 버튼에 CountFilesInSubDir, ... 버튼에 SelectFolder를 등록한다.

  • 사용방법


  • 검색 작업의 루트 폴더를 선택합니다.
  • 검색할 파일 형식을 입력합니다. *.xls* 와 같이 와일드카드 사용 가능.
  • 실행 버튼을 누릅니다.

  • →results 시트에 각 폴더의 카운트 결과가 출력됩니다. 파일이 있으면 폴더에 대한 링크가 삽입됩니다.

    해설



    작성의 동기는 단순히 폴더내의 파일이 몇개인가를 알고 싶었다고 하는 것이므로, 파일명 일람 표시 기능은 구현하고 있지 않습니다. 폴더에 링크를 삽입했으므로 링크를 누르면 해당 폴더가 열리고 내용을 확인할 수 있습니다. (수수하게 편리할지도!와 자화 자찬...)

    참조 사이트



    VBA 매크로 셀에 하이퍼링크 설정(자기롭게 Excel VBA)
    하위 폴더를 포함하여 파일 목록 가져오기(Dir 함수 재귀 호출)

    좋은 웹페이지 즐겨찾기