Excel VBAでオブジェクト指向プログラミング（FSOを利用したExcelツール編）

2021-09-282024-01-05

■FileSystemObject(FSO)を利用したExcelツール

FileSystemObject(FSO)を利用したExcelツールをいくつかご紹介します。
⇒FSOの詳細については、Excel VBAでオブジェクト指向プログラミング（FSO編）を参照して下さい。

指定したフォルダの直下にあるフォルダの一覧を表示するExcelツール

行番号9で指定したフォルダの直下にあるフォルダをExcelワークシートに表示するツールです。
行番号11でフォルダのパスをExcelワークシートのA列にセットしています。

1. Dim sht, fso, subfolder As Object
2. Dim rcnt As Long
4. Private Sub Sample1()
5.     Set sht = ActiveSheet
6.     sht.Cells.Clear
7.     rcnt = 0
8.     Set fso = New FileSystemObject
9.     For Each subfolder In fso.GetFolder(“C:\work").subfolders
10.         rcnt = rcnt + 1
11.         sht.Cells(rcnt, 1) = subfolder.path
12.     Next subfolder
13. End Sub

指定したフォルダの配下にある全フォルダの一覧を表示するExcelツール

行番号9で指定したフォルダの配下にある全フォルダをExcelワークシートに表示するツールです。
行番号15でフォルダのパスをExcelワークシートのA列にセットしています。

1. Dim sht, fso, subfolder As Object
2. Dim rcnt As Long
4. Private Sub Sample2()
5.     Set sht = ActiveSheet
6.     sht.Cells.Clear
7.     rcnt = 0
8.     Set fso = New FileSystemObject
9.     Call Sample2_sub(“C:\work")
10. End Sub
12. Public Sub Sample2_sub(path As String)
13.     For Each subfolder In fso.GetFolder(path).subfolders
14.         rcnt = rcnt + 1
15.         sht.Cells(rcnt, 1) = subfolder.path
16.         Call Sample2_sub(subfolder.path)
17.     Next subfolder
18. End Sub

指定したフォルダの直下にあるファイルの一覧を表示するExcelツール

行番号9で指定したフォルダの直下にあるファイルをExcelワークシートに表示するツールです。
行番号11でファイルのパスをExcelワークシートのA列にセットしています。

1. Dim sht, fso, file As Object
2. Dim rcnt As Long
4. Private Sub Sample3()
5.     Set sht = ActiveSheet
6.     sht.Cells.Clear
7.     rcnt = 0
8.     Set fso = New FileSystemObject
9.     For Each file In fso.GetFolder(“C:\work").files
10.         rcnt = rcnt + 1
11.         sht.Cells(rcnt, 1) = file.path
12.     Next file
13. End Sub

指定したフォルダの配下にある全ファイルの一覧を表示するExcelツール

行番号9で指定したフォルダの配下にある全ファイルをExcelワークシートに表示するツールです。
行番号15でファイルのパスをExcelワークシートのA列にセットしています。

1. Dim sht, fso, subfolder, file As Object
2. Dim rcnt As Long
4. Private Sub Sample4()
5.     Set sht = ActiveSheet
6.     sht.Cells.Clear
7.     rcnt = 0
8.     Set fso = New FileSystemObject
9.     Call Sample4_sub(“C:\work")
10. End Sub
12. Public Sub Sample4_sub(path As String)
13.     For Each file In fso.GetFolder(path).files
14.         rcnt = rcnt + 1
15.         sht.Cells(rcnt, 1) = file.path
16.     Next file
18.     For Each subfolder In fso.GetFolder(path).subfolders
19.         Call Sample4_sub(subfolder.path)
20.     Next subfolder
21. End Sub

指定したフォルダの直下にあるファイルを別のフォルダにコピーするExcelツール

行番号9で指定したフォルダ1の直下にあるファイルを行番号10で指定したフォルダ2にコピー（バックアップ）するツールです。
行番号15～16でフォルダ1のファイル名と最終更新日時をExcelワークシートのA～B列にセット、行番号22でフォルダ2の同名ファイルの最終更新日時をExcelワークシートのC列にセットし、B列≠C列の場合は行番号26でフォルダ1のファイルをフォルダ2にコピーしています。

1. Dim sht, fso, file As Object
2. Dim Folder1Path, Folder2Path As String
3. Dim rcnt, i As Long
5. Private Sub Sample5()
6.     Set sht = ActiveSheet
7.     sht.Cells.Clear
8.     Set fso = New FileSystemObject
9.     Folder1Path = “C:\work\folder1\"
10.     Folder2Path = “C:\work\folder2\"
11.     rcnt = 0
13.     For Each file In fso.GetFolder(Folder1Path).files
14.         rcnt = rcnt + 1
15.         sht.Cells(rcnt, 1) = file.Name
16.         sht.Cells(rcnt, 2) = file.DateLastModified
17.     Next file
19.     For i = 1 To rcnt
20.         If fso.FileExists(Folder2Path & sht.Cells(i, 1)) = True Then
21.             Set file = fso.GetFile(Folder2Path & sht.Cells(i, 1))
22.             sht.Cells(i, 3) = file.DateLastModified
23.         End If
24.         If sht.Cells(i, 2) <> sht.Cells(i, 3) Then
25.             sht.Cells(i, 3).Interior.Color = RGB(0, 255, 255)
26.             fso.CopyFile Folder1Path & sht.Cells(i, 1), Folder2Path
27.         End If
28.     Next i
29. End Sub