ファイル一覧作成

【環境】Windows 10 Pro 64bit、Excel for Office 365

ExcelマクロのVBAを使用して、ファイル一覧を作成しています

さていよいよですが、最後に、一覧作成ボタンと一覧消去ボタンの処理を作成していきます

■出力項目

その３で実施した通り、ファイル一覧を作成するために、Fileオブジェクトを保存するようにしました

Studio ZeSys

再帰的にファイルを検索

https://zesys.net/pc/excel/vba-file-list-vol3

【環境】Windows 10 Pro 64bit、Excel for Office 365さてさて、ファイル一覧を自動で作成するには、もちろんカレントフォルダ配下のファイルを検索する！これですよねーさー！作っていきましょー※以下の記事でも記載しましたが、本来は実行時バインディングに簡単に変換できるようなコーディングをお勧めしていますしかし、各記事の中では必要なコードだけを書いていますので、実際にご自身でコーディングされるときは、ご注意ください！Excel VBAの参照設定■FileSystemObject再三にわたり出てきているFileSystemObjectを使ってファ...

このFileオブジェクトが持つ情報を基にして、以下の内容を一覧に出力していきます

サブフォルダ名
ファイル名
タイプ
サイズ
作成日時
更新日時

■やること

一覧作成ボタンを押下した際に行うことは、ざっくりと以下になります

シート情報の取得
出力先ワークシートの取得
一覧消去
ファイル情報取得
リスト作成

細かいことを言えば、以下のこともやらなきゃですが、今回はｗ

出力シートの有無確認
出力シートの作成/削除/複製
出力及び、出力済み一覧消去等の確認メッセージ表示
出力中の進捗状況表示

・シート情報の取得

これは表紙に記載された以下の内容を取得するということですが、その２で行ったように、ボタンへのマクロ登録時に、引数として渡す方法で、実装していきます

カレントフォルダ
ファイルパターン
出力シート名

やり方を忘れた方は、こちらを確認してください

Studio ZeSys

ダイアログでフォルダを指定

https://zesys.net/pc/excel/vba-file-list-vol2

【環境】Windows 10 Pro 64bit、Excel for Office 365それでは早速？Excelシートに張り付けた「参照」ボタンを押下して、フォルダ参照のダイアログボックスを表示するプログラムを書いていきましょう！※『その１：仕様』は、以下のリンクを確認してくださいExcelでファイル一覧を作成する～その１：仕様～■フォルダ参照ダイアログボックスを呼び出す関数ファイルを参照するダイアログボックスの開き方はいくつかあるようなのですが、フォルダを参照する方法はこれしか知りませんｗFileDialog オブジェクトのフォルダピッカーを指定して...

引数でセル指定の文字列を受け取りって、セルの値を取得します

Sub MakeList(cell1 As String, cell2 As String, cell3 As String)
    Dim path    As String
    Dim ptrn    As String
    Dim name    As String
    
    path = Me.Application.ActiveSheet.Range(cell1).Text
    ptrn = Me.Application.ActiveSheet.Range(cell2).Text
    name = Me.Application.ActiveSheet.Range(cell3).Text
End Sub

Sub MakeList(cell1 As String, cell2 As String, cell3 As String)

Dim path As String

Dim ptrn As String

Dim name As String

path = Me.Application.ActiveSheet.Range(cell1).Text

ptrn = Me.Application.ActiveSheet.Range(cell2).Text

name = Me.Application.ActiveSheet.Range(cell3).Text

End Sub

あまり、わしは、「Me.Application.ActiveSheet」なんてのを沢山書くのは好きではないです

更に、この「ActiveSheet」はプロパティなんですけど、見ての通り、型が「Object」型なので、WorkSheet型の変数にSetして使うようにしています

Sub MakeList(cell1 As String, cell2 As String, cell3 As String)
    Dim wb      As Workbook
    Dim ws      As Worksheet
    Dim path    As String
    Dim ptrn    As String
    Dim name    As String
    Set wb = Me.Application.ActiveWorkbook
    Set ws = wb.Worksheets("表紙")
    path = ws.Range(cell1).Text
    ptrn = ws.Range(cell2).Text
    name = ws.Range(cell3).Text
    Set ws = Nothing
    Set wb = Nothing
End Sub

Sub MakeList(cell1 As String, cell2 As String, cell3 As String)

Dim wb As Workbook

Dim ws As Worksheet

Dim path As String

Dim ptrn As String

Dim name As String

Set wb = Me.Application.ActiveWorkbook

Set ws = wb.Worksheets("表紙")

path = ws.Range(cell1).Text

ptrn = ws.Range(cell2).Text

name = ws.Range(cell3).Text

Set ws = Nothing

Set wb = Nothing

End Sub

大したことではないのですが、Activeってのは、現在の最前面のウィンドウのこと（正確には違いますけどｗ）

Excelを複数開いていたりすると、Excelのウィンドウを切り替えた場合に、Activeが意図しないものに変わってしまいエラーの原因になります

そのため、Activeはボタンに登録するマクロで１回だけ、最初に使うだけにしましょー！

できれば、「表紙」も引数でもらえばいいですね！

・出力先ワークシートの取得

沢山ソースを書くのが、面倒になってきたので、抜粋していきますｗ

引数でもらった出力先シート名のセルの値を「name」に格納しているので、これを使って、シートのオブジェクトを取得します

Dim trg     As Worksheet
Set trg = wb.Worksheets(name)
' Set trg = wb.Sheets(name) これでも同じです
Set trg = Nothing

Dim trg As Worksheet

Set trg = wb.Worksheets(name)

' Set trg = wb.Sheets(name) これでも同じです

Set trg = Nothing

WorkBook型やWorkSheet型は変数宣言をして、Setでオブジェクトを取得し、使い終わったら、「Set (変数名) = Nothing」で開放しましょー

・一覧消去

これは「一覧消去」ボタン押下時にも呼び出せるように、サブ関数化しておきましょ！こんな感じにｗ

Sub ClearListSub(ws As Worksheet)
    Dim row     As Long
    Dim col     As Long
    Dim rows    As Long
    Dim cols    As Long
    
    row = 2     ' データ開始行
    col = 1     ' Noの列
    cols = 7    ' 列数
    rows = 100  ' 行数
   
    ws.Range(ws.Cells(row1, col1), ws.Cells(row2, col2)).ClearContents
End Sub

Sub ClearListSub(ws As Worksheet)

Dim row As Long

Dim col As Long

Dim rows As Long

Dim cols As Long

row = 2 ' データ開始行

col = 1 ' Noの列

cols = 7 ' 列数

rows = 100 ' 行数

ws.Range(ws.Cells(row1, col1), ws.Cells(row2, col2)).ClearContents

End Sub

わかりやすく書いているつもりですが、本来は列数や行数は別の方法で取得していますし、ClearContentsの処理も別関数に切り出しています

Sub ClearListSub(ws As Worksheet)
    Dim row     As Long
    Dim col     As Long
    Dim rows    As Long
    Dim cols    As Long
    
    row = LNG_START_ROW
    col = LNG_START_COL
    cols = GetLastCol(ws, row - 1) - col + 1
    rows = GetLastRow(ws, col) - row + 1
    
    Call ClearCellContents(ws, row, col, rows, cols)
End Sub

Sub ClearListSub(ws As Worksheet)

Dim row As Long

Dim col As Long

Dim rows As Long

Dim cols As Long

row = LNG_START_ROW

col = LNG_START_COL

cols = GetLastCol(ws, row - 1) - col + 1

rows = GetLastRow(ws, col) - row + 1

Call ClearCellContents(ws, row, col, rows, cols)

End Sub

定数やサブ関数の中身は、ご想像にお任せしますｗ　いつか公開するかもですが、想像つきますよねー？

・ファイル情報取得

これは「その３」で説明したので、割愛しますｗ

Studio ZeSys

再帰的にファイルを検索

https://zesys.net/pc/excel/vba-file-list-vol3

・リスト作成

あとはファイル情報取得で取得したdataを以下のように関数に渡して、For…Eachステートメントで回しながら、Fileオブジェクトに取得して、各プロパティを出力項目に割り当てていくだけです！

Sub MakeListSub(ws As Worksheet, data As Collection, path As String)
    Dim row     As Long
    Dim no      As Long
    Dim fl      As File
    
    row = LNG_START_ROW
    no = 0
    
    For Each fl In data
        ' No.
        ws.Cells(row + no, 1).Value = no + 1
        ' サブフォルダ名
        ws.Cells(row + no, 2).Value = Replace(fl.ParentFolder, path, "")
        ' ファイル名
        ws.Cells(row + no, 3).Value = fl.Name
        ' タイプ
        ws.Cells(row + no, 4).Value = fl.Type
        ' サイズ
        ws.Cells(row + no, 5).Value = fl.Size
        ' 作成日時
        ws.Cells(row + no, 6).Value = Format(fl.DateCreated, "yyyy/mm/dd hh:nn:ss")
        ' 更新日時
        ws.Cells(row + no, 7).Value = Format(fl.DateLastModified, "yyyy/mm/dd hh:nn:ss")
        ' Noをカウントアップ
        no = no + 1
    Next
    
End Sub

Sub MakeListSub(ws As Worksheet, data As Collection, path As String)

Dim row As Long

Dim no As Long

Dim fl As File

row = LNG_START_ROW

no = 0

For Each fl In data

' No.

ws.Cells(row + no, 1).Value = no + 1

' サブフォルダ名

ws.Cells(row + no, 2).Value = Replace(fl.ParentFolder, path, "")

' ファイル名

ws.Cells(row + no, 3).Value = fl.Name

' タイプ

ws.Cells(row + no, 4).Value = fl.Type

' サイズ

ws.Cells(row + no, 5).Value = fl.Size

' 作成日時

ws.Cells(row + no, 6).Value = Format(fl.DateCreated, "yyyy/mm/dd hh:nn:ss")

' 更新日時

ws.Cells(row + no, 7).Value = Format(fl.DateLastModified, "yyyy/mm/dd hh:nn:ss")

' Noをカウントアップ

no = no + 1

End Sub

Valueにセットするのもサブ関数にしてしまう悪い癖があるので、判り易くベタに記載しておきますねｗ

列番号もEnumで定義することをお勧めします！

実際の一覧表を作成するときには、セルの罫線や書式の設定も必要になってきますので、その辺りはお好みで実装してください

■まとめると

一覧作成ボタンのマクロをを以下に掲載しますが、エラーチェック等は割愛していますので、程々に実装してくださいねーｗ

' 一覧作成
Sub MakeList(mysheet As String, cell1 As String, cell2 As String, cell3 As String)
    Dim wb      As Workbook
    Dim ws      As Worksheet
    Dim trg     As Worksheet
    Dim path    As String
    Dim ptrn    As String
    Dim name    As String
    Dim data    As Collection
    
    ' アクティブなワークブックを取得する
    Set wb = Me.Application.ActiveWorkbook
    ' 表紙のワークシートを取得する
    Set ws = wb.Worksheets(mysheet)
    
    path = GetTextRange(ws, cell1)  ' カレントフォルダ
    ptrn = GetTextRange(ws, cell2)  ' ファイルパターン
    name = GetTextRange(ws, cell3)  ' 出力先シート名
    
    ' 出力先
    Set trg = wb.Worksheets(name)
    
    ' 消去
    Call ClearListSub(trg)
    
    ' Fileオブジェクトを格納するコレクションを作成する
    Set data = New Collection
    
    ' ファイル取得
    Call GetFileInfo(data, path, ptrn)
    
    ' リスト作成
    Call MakeListSub(trg, data, path)
    
    ' 後処理
    Set data = Nothing
    Set trg = Nothing
    Set ws = Nothing
    Set wb = Nothing
End Sub

' 一覧作成

Sub MakeList(mysheet As String, cell1 As String, cell2 As String, cell3 As String)

Dim wb As Workbook

Dim ws As Worksheet

Dim trg As Worksheet

Dim path As String

Dim ptrn As String

Dim name As String

Dim data As Collection

' アクティブなワークブックを取得する

Set wb = Me.Application.ActiveWorkbook

' 表紙のワークシートを取得する

Set ws = wb.Worksheets(mysheet)

path = GetTextRange(ws, cell1) ' カレントフォルダ

ptrn = GetTextRange(ws, cell2) ' ファイルパターン

name = GetTextRange(ws, cell3) ' 出力先シート名

' 出力先

Set trg = wb.Worksheets(name)

' 消去

Call ClearListSub(trg)

' Fileオブジェクトを格納するコレクションを作成する

Set data = New Collection

' ファイル取得

Call GetFileInfo(data, path, ptrn)

' リスト作成

Call MakeListSub(trg, data, path)

' 後処理

Set data = Nothing

Set trg = Nothing

Set ws = Nothing

Set wb = Nothing

End Sub

■一覧消去ボタン

上のまとめたソースから必要なものだけを残せば、一覧消去ボタン押下時の関数はできてしまいますよね

Sub ClearList(mysheet As String, cell As String)
    Dim wb      As Workbook
    Dim ws      As Worksheet
    Dim trg     As Worksheet
    Dim name    As String
    
    Set wb = Me.Application.ActiveWorkbook
    Set ws = wb.Worksheets(mysheet)
    
    name = GetTextRange(ws, cell)
    Set trg = wb.Worksheets(name)
    
    Call ClearListSub(trg)
    
    Set trg = Nothing
    Set ws = Nothing
    Set wb = Nothing
End Sub

Sub ClearList(mysheet As String, cell As String)

Dim wb As Workbook

Dim ws As Worksheet

Dim trg As Worksheet

Dim name As String

Set wb = Me.Application.ActiveWorkbook

Set ws = wb.Worksheets(mysheet)

name = GetTextRange(ws, cell)

Set trg = wb.Worksheets(name)

Call ClearListSub(trg)

Set trg = Nothing

Set ws = Nothing

Set wb = Nothing

End Sub

説明はいらないかな？ｗ

■完成

というわけで、無事に一覧表が完成しました！

■最後に

今回はありきたりな画像ファイルを一覧するだけに留めていますが、何かとファイル一覧が必要になることは多いと思います

これをベースにCSVやExcelファイルを一覧して、更に、そのファイルを開いて自動処理をしていくなんてことも考えられますよね！？

もちろん、画像ファイルの一覧だって、これをベースにショッピングモールに出品する商品リストを作成するなんてことも・・

というわけで、今後は、以下のようなことを書いていこうかと思います

セル制御、行挿入、列挿入、書式設定、条件付き書式、入力規則設定
Excelシート一覧、シートを開く、シートの成型
CSVファイル一覧、特定データの抽出、グラフ化、作表、集計
HTML解析…等

やりたいことを挙げたらキリがないｗ

時間との兼ね合いで、簡単なところから、手を付けていきたいと思います！

ではでは

カテゴリー:ファイル一覧

タグ:サンプル

やもす ʕ•͡-•ʔ

のんびり！のほほん！がモットーです！ｗ蕎麦食いたいライブ行きたい暑いの嫌い

■出力項目

■やること

・シート情報の取得

・出力先ワークシートの取得

・一覧消去

・ファイル情報取得

・リスト作成

■まとめると

■一覧消去ボタン

■完成

■最後に

関連投稿

VBScriptの覚書

再帰的にファイルを検索

ダイアログでフォルダを指定