.png)
今回は、選択したフォルダからファイル一覧を取得するコードをご紹介します。なお、ファイル一覧の処理だけでなく、フォルダの存在確認、新しいシートの挿入方法、日付とFormat関数、セルの書式設定についても学ぶことができます。
業務側の要望として、変更した箇所の文字や背景に色を付けたいとか結構あるので、これを機会に覚えてしまいましょう。
以前、ユーザーがその都度ファイルを選べるように、ファイル選択ダイアログを表示する処理をご紹介しましたが、今回はフォルダ選択ダイアログを表示させるコードもご紹介します。ファイルの選択ダイアログについては下記の記事をご参照ください。
.png)
【ExcelVBA】ファイル選択ダイアログを表示させる | ともゆきの独り言(雑記ブログ)
ExcelVBAでファイル選択ダイアログを表示して、選択したファイルパスを表示させる処理の備忘録です。今回はユーザーインターフェースの部分になるため、簡単な画面設計も含めてご紹介いたします。
今回は、ソースコードの行数は多いですが、決して難しい処理はしていません。フォルダ構成および画面設計の環境を整え、作成してみてください。
フォルダ構成
先に業務環境の把握から。年フォルダの中に毎月の集計表が格納されています。この集計表が何月分まで格納されているか一覧を出力したい...という処理をします。
このテストデータだとデータ量が少ないため、マクロを組むにも至らず手作業でも直ぐにできそうではあるのですが...こういった年月日で綺麗に管理させていれば本来手間がかかることはないのですけども。取り敢えずで適当に格納していると...笑
ファイル一覧を出力する機会というのは無さそうに見えて、極々たまにあります笑 監査対象で慌てて整理するなんてこともありますしねぇw
画面設計
ファイル選択ダイアログを表示させる処理とほぼ同じですが、画像に記載してある通り、実行結果後のパスのお尻に「¥」(円マーク)は付与されません。それだけ覚えておいてください。
- シート名:入力画面
- セルC2:フォルダパスとして名前付け
- 参照ボタン:フォルダ選択 マクロの登録
- ファイル一覧出力:ファイル一覧の作成 マクロの登録
処理実行結果
「ファイル一覧出力」ボタンを押すことで、同じExcelブック内の新規シートにファイル一覧を書き出します。
フォルダ選択ダイアログ - ソースコード(ExcelVBA)
Option Explicit
Private ObjWSH As WshShell
Sub フォルダ選択()
Set ObjWSH = New WshShell
Dim SetFolder As String
SetFolder = ObjWSH.SpecialFolders("Desktop")
ChDrive Drive:="C"
ChDir Path:=SetFolder
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = SetFolder
If .Show = True Then
ThisWorkbook.Worksheets("入力画面").Range("フォルダパス") = .SelectedItems(1)
Else
MsgBox "キャンセルしました。"
End If
End With
End Sub
フォルダ選択ダイアログ - ポイント
- 実行にはツールの参照設定から「Windows Script Host Object Model」にチェックを入れてください。
- SpecialFolders(”Desktop”)でデスクトップのパスを取得し、ChDir Pathでデスクトップを初期位置としています。
- ファイル選択ダイアログの処理の時とは違い、今回は「Application.FileDialog」を使用しています。
ファイル一覧出力 - ソースコード(ExcelVBA)
Option Explicit
Private ObjFSO As FileSystemObject
Sub ファイル一覧の作成()
Set ObjFSO = New FileSystemObject
Dim WS As Worksheet
Dim FolderPath As String
Set WS = Worksheets("入力画面")
FolderPath = WS.Range("フォルダパス")
If ObjFSO.FolderExists(FolderPath) = False Then
MsgBox "フォルダが存在しません。"
End
End If
Dim NewWS As Worksheet
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Format(Now, "yyyyMMdd_hhmmss")
Set NewWS = ActiveSheet
With NewWS
.Cells.Font.Name = "Meiryo UI"
.Cells(1, 1) = "ファイル名一覧"
.Cells(1, 1).Font.Bold = True
.Cells(1, 1).Font.Size = 16
.Cells(2, 1) = "ファイル名"
.Cells(2, 1).Font.ColorIndex = 56
.Cells(2, 1).Interior.ColorIndex = 15
Columns("A").ColumnWidth = 30
.Cells(2, 2) = "更新日時"
.Cells(2, 2).Font.ColorIndex = 56
.Cells(2, 2).Interior.ColorIndex = 15
Columns("B").ColumnWidth = 20
End With
Dim YearFolder As Folder
Dim FilesCollection As Files
Dim CurrentFile As File
Dim i As Long: i = 3
Set YearFolder = ObjFSO.GetFolder(FolderPath)
Set FilesCollection = YearFolder.Files
For Each CurrentFile In FilesCollection
NewWS.Cells(i, 1).Value = CurrentFile.Name
NewWS.Cells(i, 2).Value = CurrentFile.DateLastModified
i = i + 1
Next
ThisWorkbook.Save
End Sub
ファイル一覧出力 - ポイント
- 実行にはツールの参照設定から「Microsoft Scripting Runtime」にチェックを入れてください。
- フォルダの存在確認として、フォルダパスに入力したフォルダが見当たらなった場合、メッセージを表示して何もせずに処理を終了させています。
- 新規ワークシートを挿入する際、常に一番右側に挿入するようにしています。
- シート名は日時にしています。Excelの仕様として、同じ名前のシート名を作成することはできません。Now関数で現在日時を取得し、Format関数で表示書式を変換しています。
コメントを投稿
別ページに移動します