FileSystemObjectとは?CreateObject 関数 FolderExists・GetFolderの使い方(Excel VBA)

先日お話ししました

指定したフォルダの全ての階層のフォルダ名・サブフォルダ名・ファイル名を取得(Excel VBA)

のFileSystemObjectの説明です。

  1. セルB3に、フォルダ・サブフォルダ・ファイル名を取得したいフォルダのパスを入力
  2. セルB6に、一覧表を作りたいセル範囲の左上のセルアドレスを入力
  3. <フォルダ・ファイル名一覧作成>ボタンをクリック
    ↓↓↓
    セルB6に入力したアドレスに、ファイル・フォルダ一覧表が完成

先日作成したVBAは下記の通りです。
FileSystemObjectオブジェクトとは?
今回のミッションはフォルダ名やファイル名の取得、ということもあり、至る所でFileSystemObjectオブジェクトが登場しています。(下記コードオレンジ色部
(変数「FSO」にセットしています。)

'【変数】
Dim s_row As Long '開始行
Dim s_col As Long '開始列
Dim e_col As Long '終了列

Sub 指定したフォルダ内の全階層のフォルダ名とファイル名で一覧作成()
    '【変数】
    'ファイル・シート関連関連
    Dim FSO As Object   'FileSystemObject
    Dim Pt As String    '対象フォルダパス
    '行列関連
    Dim t_row As Long   '対象行
    Dim t_col As Long   '対象列

    Application.ScreenUpdating = False '画面表示の停止

    '■変数セット
    s_row = Range(Range("B6")).Row    '開始行
    s_col = Range(Range("B6")).Column '開始行
    t_row = s_row + 1                 '対象行
    t_col = s_col                     '対象列
    e_col = t_col                     '最終列

    '■FileSystemObjectのインスタンス化
    Set FSO = CreateObject("Scripting.FileSystemObject")

    '■対象フォルダパス(最後に「\」が無ければ「\」を付ける)
    If Right(Pt, 1) = "\" Then
        Pt = Range("B3")
    Else
        Pt = Range("B3") & "\"
    End If

    '■対象フォルダの有無の確認
    If Not FSO.FolderExists(Pt) Then
        MsgBox ("ご指定のフォルダは存在しません。")
        Exit Sub
    End If

    '■前回データのクリア
    Rows(s_row & ":" & Cells.Rows.Count).Clear

    '■再帰処理開始
    Call フォルダファイル名取得(FSO, Pt, t_row, t_col)

    '■列幅の調整
    Range(Columns(t_col), Columns(Columns.Count)).ColumnWidth = 3
    Range(Columns(e_col), Columns(e_col + 2)).EntireColumn.AutoFit

    '■サイズ、更新日時の罫線設定
    Range(Cells(s_row, e_col + 1), Cells(t_row - 1, e_col + 1)).BorderAround Weight:=xlHairline, LineStyle:=xlContinuous
    Range(Cells(s_row, t_col), Cells(t_row - 1, e_col + 2)).BorderAround LineStyle:=xlContinuous

    '■見出し設定
    Cells(s_row, s_col) = "フォルダ・ファイル名"
    Cells(s_row, e_col + 1) = "サイズ"
    Cells(s_row, e_col + 2) = "更新日時"
    Range(Cells(s_row, e_col + 1), Cells(s_row, e_col + 2)).HorizontalAlignment = xlCenter

    Application.Goto reference:=Range("A1"), scroll:=True
    Range(Range("B3"), Range("XFD2")).ClearFormats

    '■オブジェクトの解放
    Set FSO = Nothing

    Application.ScreenUpdating = False '画面表示の再開

End Sub

Sub フォルダファイル名取得(FSO As Object, Pt As String, t_row As Long, t_col As Long)

    '【変数】
    Dim s_Fd As Object 'サブフォルダ
    Dim Fl As Object 'ファイル
    Dim strSplit() As String

    '■最終列が増えた場合、サイズ列の前に1列追加
    If t_col > e_col Then
        Columns(t_col).Insert Shift:=xlToRight
        e_col = t_col
    End If

    '■サブフォルダの取得
    For Each s_Fd In FSO.GetFolder(Pt).SubFolders '変数S_FdにFdフォルダ内のフォルダ名を順に取得
        '□サブフォルダ名転記
        Cells(t_row, t_col) = s_Fd.Name

        '□サブフォルダにハイパーリンクを設定
        ActiveSheet.Hyperlinks.Add _
            Anchor:=Cells(t_row, t_col), _
            Address:=s_Fd.Path, _
            TextToDisplay:=s_Fd.Name

        '□サブフォルダ名罫線設定
        Call 罫線(t_row, t_col)

        t_row = t_row + 1

        '□再帰処理
        Call フォルダファイル名取得(FSO, s_Fd.Path, t_row, t_col + 1)
    Next s_Fd

    '■ファイル名の取得
    For Each Fl In FSO.GetFolder(Pt).Files

        '□ファイル名転記
        Cells(t_row, t_col) = Fl.Name

        '■Excel・csvファイルはハイパーリンク設定
        strSplit = Split(Fl.Path, ".")

        If UBound(strSplit) > 0 Then
            Select Case LCase(strSplit(UBound(strSplit)))
                Case "xls", "xlsx", "xlsm", "csv"
                    ActiveSheet.Hyperlinks.Add _
                        Anchor:=Cells(t_row, t_col), _
                        Address:=Fl.Path, _
                        TextToDisplay:=Fl.Name
            End Select
        End If

        '□ファイルサイズ・更新日時転記
        Cells(t_row, e_col + 1) = WorksheetFunction.RoundUp(Fl.Size / 1024, 0)
        Cells(t_row, e_col + 1).NumberFormatLocal = "#,##0 ""KB"""
        Cells(t_row, e_col + 2) = Fl.DateLastModified
        Cells(t_row, e_col + 2).NumberFormatLocal = "yyyy/mm/dd hh:mm:ss"

        '■ファイル名罫線
        Call 罫線(t_row, t_col)

        t_row = t_row + 1
    Next Fl

    '■オブジェクトの解放
    Set s_Fd = Nothing
    Set Fl = Nothing

End Sub

Sub 罫線(t_row As Long, t_col As Long)

    '■左の罫線
    If t_col > s_col Then
        With Range(Cells(t_row, s_col), Cells(t_row, t_col - 1))
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlInsideVertical).LineStyle = xlContinuous
        End With
    End If

    '■上の罫線
    With Range(Cells(t_row, t_col), Cells(t_row, e_col + 2))
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
    End With

End Sub

以前、

CreateObject(“Scripting.FileSystemObject”) を使ってサブフォルダを取得

でもお話ししましたが、再度こちらでもご説明いたします。

■スポンサーリンク

■FileSystemObject

ファイルやフォルダは、セルやシートと違って、Excel上には存在しない外部オブジェクトです。

なので、VBAでファイルやフォルダを操作する(作成、削除、移動、コピー等)ときには、「FileSystemObject」というオブジェクトを使用しないといけません。

では、Excel上に存在しない外部オブジェクト「FileSystemObject」を使用するにはどうしたらいいのでしょうか?

私はCreateObject 関数を使用します。

■CreateObject関数

CreateObject関数を利用することで、FileSystemObjectを使うことができるようになります。

【CreateObject 関数の利用方法】

Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")

***変数「FSO」を利用した処理***

Set FSO = Nothing
  1. まず、変数「FSO」をObjectとして宣言します。
    参照設定をしていないので、「FileSystemObject」への宣言はできません。

    Dim FSO As Object

  2. 次に、CreateObject関数を利用して、変数「FSO」にFileSystemObjectをセットします。

    Set FSO = CreateObject(“Scripting.FileSystemObject”)


    この記述をすることで、変数「FSO」をFileSystemObjectとして使うことができます。

    例1:FSO.FolderExists(フォルダパス)→フォルダ存在の確認します。
            If Not FSO.FolderExists(Pt) Then

    例2:FSO.GetFolder(フォルダパス)→フォルダー オブジェクトを返します。
            For Each s_Fd In FSO.GetFolder(Pt).SubFolders

    例3:Callステートメントで引数として渡すことができます。
            Call フォルダファイル名取得(FSO, Pt, t_row, t_col) 
     
  3. 処理の最後に、変数「FSO」を解放します。

    Set FSO = Nothing

CreateObject関数ではなく参照設定を利用する方法もあります。しかし、参照設定では、バージョンの違いでエラーが出ることがあります。
私が業務で作る場合は、色々なPC環境で色々な方が使用することが多いので、参照設定は使用しないようにしています。

CreateObject関数参照設定の違いにつきましては

FileSystemObject CreateObject関数を使う方法・ 参照設定を使う方法 違いを理解してエラー防止

をご参照ください。

■FolderExistsメソッド

指定したフォルダーが存在するかどうかを確認します。

If Not FSO.FolderExists(Pt) Then

変数「Pt」に「C:\VBA\」という対象フォルダパスのテキストがセットされた場合、

通常は「C:\VBA\」フォルダが存在する場合に「True」が返ります。

しかし、今回は「Not」が前に付いていますので、

「C:\VBA\」フォルダが存在しない場合に「True」が返ります。

■GetFolderメソッド

指定したパスのフォルダーオブジェクトを返します。

【SubFoldersプロパティ】

フォルダーオブジェクトには、対象のフォルダのサブフォルダを取得するSubFoldersプロパティがあります。

フォルダーオブジェクト.SubFolders

今回は、For Eachを使って、変数「s_Fd」に対象フォルダ(変数Ptにセットされたパスのフォルダ)のサブフォルダを順番に格納する処理しています。

For Each s_Fd In FSO.GetFolder(Pt).SubFolders
・
・
Next s_Fd

変数「s_Fd」にサブフォルダを格納することで、下記のように情報を得ることができます。

s_Fd.Name:サブフォルダ名の取得
s_Fd.Path:サブフォルダのパス


【Filesプロパティ】

フォルダーオブジェクトには、フォルダ内に存在する全てのファイルオブジェクトを返すFilesプロパティがあります。

フォルダーオブジェクト.Files

今回は、For Eachを使って、変数「Fl」に対象フォルダ内(変数Ptにセットされたパスのフォルダ)のファイルオブジェクトを順番に格納する処理しています。

For Each Fl In FSO.GetFolder(Pt).Files
・
・
Next Fl

変数「Fl」にファイルオブジェクトを格納することで、下記のように情報を得ることができます。

Fl.Name:ファイル名
Fl.Path:ファイルのパス
Fl.Size:ファイルのサイズ
Fl.DateLastModified:ファイルの更新日時

Excelとは無関係のファイルやフォルダの操作もできちゃうって・・・。

Excelってすごいですね♪

【参考】
指定したフォルダ内のファイル名全てを取得(Excel VBA)
変数でよく使われる「buf」「tmp」の意味
Dir関数が取得するファイルの順番
指定したフォルダ内のフォルダ名全てをGetAttrを使って「エラー53 ファイルが見つかりません。」を出さずに取得(Excel VBA)
GetAttrとは?「= vbDirectory」ではなく「And vbDirectory」となるビット演算の疑問
フォルダ名だけを取得したい時に出てくる 「.」 と 「..」 とは?
指定したフォルダ内とサブフォルダ内全てのファイル名を取得(Excel VBA)
CreateObject(“Scripting.FileSystemObject”) を使ってサブフォルダを取得
再帰処理とは?フォルダ内とサブフォルダ内全てのファイル名を取得(Excel VBA)
指定したフォルダ内のサブフォルダのフォルダ名を全部取得(Excel VBA)
参照渡し「ByRef」と値渡し「ByVal」の違い(Excel VBA)
Callステートメントとは
再帰処理とは?フォルダ内のサブフォルダのフォルダ名を全部取得(Excel VBA)
指定したフォルダの全階層のフォルダ名・サブフォルダ名・ファイル名の一覧表作成(Excel VBA)
FileSystemObject CreateObject関数を使う方法・ 参照設定を使う方法 違いを理解してエラー防止
再帰処理とは?指定したフォルダの全ての階層のフォルダ名・サブフォルダ名・ファイル名を取得(Excel VBA)
指定したフォルダ内から「特定の文字を含まないファイル名」を取得(Excel VBA)

■スポンサーリンク

■ランキングに参加しています。
↓このブログを気に入っていただけましたら、ポチッとお願いします。
にほんブログ村 IT技術ブログへ
にほんブログ村