Excel VBAで実用ツール（FSO、dirコマンド、WshShellオブジェクト編）

2022-02-192024-01-07

■FSO(FileSystemObject)を利用した、ファイル一覧ツール

あるディレクトリの配下に格納されているファイルを(サブフォルダ内のファイルも含めて)全て一覧にし、下図のように「フォルダ名」「ファイル名」「サイズ」「更新日時」を表示するツールを作成しましたので、ご紹介します。

(出力結果のイメージ)

フォルダ名	ファイル名	サイズ	更新日時
C:\xxxxx	xxxxx.xxx	nnnnn	yyyy/mm/dd hh:mm:ss

このような処理を行いたい場合、FSO(FileSystemObject)を利用すると、フォルダやファイルを操作する処理を簡単に実現することができます。

FSOはMicrosoftから提供されている、ファイルシステムへのアクセスに特化したオブジェクトで、フォルダやファイルを操作するためのメソッドやプロパティが提供されています。
⇒FSOの詳細については、Excel VBAでオブジェクト指向プログラミング（FSO編）、FSOを利用したツールについては、Excel VBAでオブジェクト指向プログラミング（FSOを利用したExcelツール編）を参照して下さい。

サンプル・プログラム(1)

行番号11～17で見出し項目を設定し、行番号20で基点となるフォルダを指定してサブ・プロシジャを呼び出し、再帰的に処理を行っています。
サブ・プロシジャは2つの部分に分かれており、行番号28～34でフォルダの直下にあるファイルを順に一覧表示し、行番号35～37でフォルダの下にあるサブフォルダを指定して、サブ・プロシジャを再帰呼び出ししています。

1. Dim sht As Worksheet
2. Dim fso As FileSystemObject
3. Dim f As File
4. Dim s As Folder
5. Dim rcnt As Long
7. Private Sub Sample1()
8.     Application.ScreenUpdating = False
9.     Set sht = ActiveSheet
10.     sht.Cells.Clear
11.     sht.Range(“A1") = “フォルダ名"
12.     sht.Range(“B1") = “ファイル名"
13.     sht.Range(“C1") = “サイズ"
14.     sht.Range(“D1") = “更新日時"
15.     sht.Range(“A1:D1").Interior.Color = RGB(127, 127, 127)
16.     sht.Range(“A1:D1").Font.Bold = True
17.     sht.Range(“A1:D1").HorizontalAlignment = xlCenter
18.     rcnt = 1
19.     Set fso = New FileSystemObject
20.     Call Sample1_sub(“C:\work")
21.     Set f = Nothing
22.     Set s = Nothing
23.     Set fso = Nothing
24.     Application.ScreenUpdating = True
25. End Sub
27. Public Sub Sample1_sub(path As String)
28.     For Each f In fso.GetFolder(path).Files
29.         rcnt = rcnt + 1
30.         sht.Cells(rcnt, 1) = f.ParentFolder
31.         sht.Cells(rcnt, 2) = f.Name
32.         sht.Cells(rcnt, 3) = f.Size
33.         sht.Cells(rcnt, 4) = f.DateLastModified
34.     Next f
35.     For Each s In fso.GetFolder(path).SubFolders
36.         Call Sample1_sub(s.path)
37.     Next s
38. End Sub

■dirコマンドを利用した、ファイル一覧ツール

前項で紹介したFSOを利用する方法が最もシンプルでわかり易いと思いますが、筆者が処理対象としたフォルダはネットワーク・ドライブで、ファイル数が10万ファイルを超えていたことから、処理時間が長くかかって耐えられない状況だったため、試行錯誤しながら処理方式を見直しました。

コマンド・プロンプトに内蔵されているdirコマンドを利用すれば、指定したディレクトリ配下のファイルを表示することができるため、出力結果を加工すればファイル一覧を作成することができます。

dirコマンドの使用法

dirはコマンド・プロンプトに内蔵されているため、コマンド・プロンプトから「dir」と打つだけで実行できます。
dirには多くのスイッチがありますが、「/s」を指定すると、指定したディレクトリ配下のファイルを全て表示することができます。

コマンド・プロンプトから「dir /?」と入力すれば、使用法が表示されます（下図参照）。

• ディレクトリ中のファイルとサブディレクトリを一覧表示します。
• DIR [ドライブ:][パス][ファイル名] [/A[[:]属性]] [/B] [/C] [/D] [/L] [/N]
•   [/O[[:]ソート順]] [/P] [/Q] [/R] [/S] [/T[[:]タイムフィールド]] [/W] [/X] [/4]
•   [ドライブ:][パス][ファイル名]
•               一覧表示するドライブ、ディレクトリ、またはファイルを指定します。
•   /A      指定された属性のファイルを表示します。
•   属性   D  ディレクトリ                R  読み取り専用
•            H  隠しファイル                A  アーカイブ
•            S  システム ファイル          I  非インデックス対象ファイル
•            L  再解析ポイント             O  オフライン ファイル
•            –  その属性以外
•   /B      ファイル名のみを表示します (見出しや要約が付きません)。
•   /C      ファイル サイズを桁区切り表示します。これは
•             既定の設定です。/-C とすると桁区切りが表示されません。
•   /D       /W と同じですが、ファイルを列で並べ替えた一覧を表示します。
•   /L       小文字で表示します。
•   /N      ファイル名を右端に表示する一覧形式を使用します。
•   /O      ファイルを並べ替えて表示します。
•   sortorder    N  名前順 (アルファベット)       S  サイズ順 (小さい方から)
•                    E   拡張子順 (アルファベット)    D  日時順 (古い方から)
•                    G  グループ (ディレクトリから) – 降順
•   /P        1 画面ごとに一時停止して表示します。
•   /Q       ファイルの所有者を表示します。
•   /R       ファイルの代替データ ストリームを表示します。
•   /S       指定されたディレクトリおよびそのサブディレクトリのすべてのファイルを表示します。
•   /T       どのタイム フィールドを表示するか、または並べ替えに使用するかを指定します。
•             タイムフィールド   C  作成
•                 A  最終アクセス
•                W  最終更新
•   /W      ワイド一覧形式で表示します。
•   /X       このオプションは 8dot3 形式以外のファイル名に対する短い名前を
•             表示します。長い名前の前に短い名前を表示する点を除けば
•   /N      オプションと同じです。短い名前がない場合は、
•             ブランクになります。
•   /4       4 つの数字で年を表示します。
• 環境変数 DIRCMD にスイッチを設定できます。
• /-W のように – (ハイフン) を付けると、そのスイッチは無効になります。

出力結果は、以下のようなイメージです。

•  ドライブ C のボリューム ラベルは xxx です
•  ボリューム シリアル番号は xxxx-xxxx です
•  c:\xxx のディレクトリ
• yyyy/mm/dd hh:mm    <DIR>          .
• yyyy/mm/dd hh:mm    <DIR>          ..
• yyyy/mm/dd hh:mm    <DIR>         xxx
• yyyy/mm/dd hh:mm             n,nnn xxx.xxx
• n 個のファイル n,nnn バイト
• n 個のディレクトリ nnn,nnn,nnn,nnn バイトの空き領域

コマンド・プロンプトを起動し、「dir /s > xxx.txt」のようにリダイレクトすれば、出力結果がテキスト・ファイルに保存されますので、これを入力して編集すれば前項と同様のファイル一覧を作成することかできます。

サンプル・プログラム(2)～テキスト入力

行番号17～23で見出し項目を設定した後、行番号27でdirコマンドの出力結果ファイルをオープンし、行番号28～54で1行ずつ入力して繰返し処理を行い、行番号55でファイルをクローズしています。
繰返し処理の中では、行番号30～33でフォルダ名を退避したうえ、ファイル単位の情報を取得しており、行番号39で更新日時、行番号44でファイル・サイズ、行番号45でファイル名を退避し、行番号47～50でExcelシートにセットしています。

1. Dim sht As Worksheet
2. Dim buf As String
3. Dim FolderName As String
4. Dim FileName As String
5. Dim FileSize As String
6. Dim TimeStamp As Date
7. Dim wstr0 As String
8. Dim wstr1 As String
9. Dim num As Integer
10. Dim pos As Integer
11. Dim rcnt As Long
13. Private Sub Sample2()
14.     Application.ScreenUpdating = False
15.     Set sht = ActiveSheet
16.     sht.Cells.Clear
17.     sht.Range(“A1") = “フォルダ名"
18.     sht.Range(“B1") = “ファイル名"
19.     sht.Range(“C1") = “サイズ"
20.     sht.Range(“D1") = “更新日時"
21.     sht.Range(“A1:D1").Interior.Color = RGB(127, 127, 127)
22.     sht.Range(“A1:D1").Font.Bold = True
23.     sht.Range(“A1:D1").HorizontalAlignment = xlCenter
24.     rcnt = 1
26.     num = FreeFile
27.     Open “C:\work\xxx.txt" For Input As #num
28.     Do Until EOF(num)
29.         Line Input #num, buf
30.         pos = InStr(buf, “のディレクトリ")
31.         If pos > 0 Then
32.             FolderName = Trim(Left(buf, pos – 1))
33.         End If
34.         pos = InStr(buf, " “)
35.         If pos > 0 Then
36.             wstr1 = Trim(Left(buf, pos – 1))
37.             wstr0 = Trim(Mid(buf, pos + 1))
38.             If IsDate(wstr1) = True Then
39.                 TimeStamp = wstr1
40.                 pos = InStr(wstr0, " “)
41.                 If pos > 0 Then
42.                     wstr1 = Trim(Left(wstr0, pos – 1))
43.                     wstr0 = Trim(Mid(wstr0, pos + 1))
44.                     FileSize = wstr1
45.                     FileName = wstr0
46.                     rcnt = rcnt + 1
47.                     sht.Cells(rcnt, 1) = FolderName
48.                     sht.Cells(rcnt, 2) = FileName
49.                     sht.Cells(rcnt, 3) = FileSize
50.                     sht.Cells(rcnt, 4) = TimeStamp
51.                 End If
52.             End If
53.         End If
54.     Loop
55.     Close #num
56.     Application.ScreenUpdating = True
57. End Sub

サンプル・プログラム(3)～バイナリ入力

サンプル・プログラム(2)は、Line Inputによるテキスト入力を行っており、データ量が多くなると相当の処理時間がかかるため、バイナリ・モードで一括入力し、行単位に分割して配列に格納するように改良したものです。
⇒正確な処理時間を測定していませんが、前項のプログラムで30分以上かかっていた処理が、このプログラムでは1分もかからずに実行できるようになりました。

全体の流れは前項のサンプル・プログラムと同様ですが、行番号29でdirコマンドの出力結果ファイルをバイナリ・モードでオープン、行番号30で入力エリアを確保、行番号31でファイル全体を読み込み、行番号32でファイルをクローズした後、行番号33で読み込んだbyte型の配列をstring型の配列に変換し、行番号34で行単位に分割して配列に格納しています。
行番号36～61の繰返し処理では、ファイルを入力する代りに、分割後の配列を順に処理しており、行番号37～40でフォルダ名を退避したうえ、ファイル単位の情報を取得しており、行番号46で更新日時、行番号51でファイル・サイズ、行番号52でファイル名を退避し、行番号54～57でExcelシートにセットしています。

1. Dim sht As Worksheet
2. Dim buf() As Byte
3. Dim var_buf() As String
4. Dim str_buf As String
5. Dim FolderName As String
6. Dim FileName As String
7. Dim FileSize As String
8. Dim TimeStamp As Date
9. Dim wstr0 As String
10. Dim wstr1 As String
11. Dim num As Integer
12. Dim pos As Integer
13. Dim rcnt As Long
14. Dim i As Integer
16. Private Sub Sample3()
17.     Application.ScreenUpdating = False
18.     Set sht = ActiveSheet
19.     sht.Cells.Clear
20.     sht.Range(“A1") = “フォルダ名"
21.     sht.Range(“B1") = “ファイル名"
22.     sht.Range(“C1") = “サイズ"
23.     sht.Range(“D1") = “更新日時"
24.     sht.Range(“A1:D1").Interior.Color = RGB(127, 127, 127)
25.     sht.Range(“A1:D1").Font.Bold = True
26.     sht.Range(“A1:D1").HorizontalAlignment = xlCenter
27.     rcnt = 1
28.     num = FreeFile
29.     Open “C:\work\xxx.txt" For Binary As #num
30.     ReDim buf(LOF(num))
31.     Get #num, , buf
32.     Close #num
33.     str_Uni = StrConv(buf(), vbUnicode)
34.     var_buf = Split(str_Uni, vbCrLf)
36.     For i = LBound(var_buf) To UBound(var_buf)
37.         pos = InStr(var_buf(i), “のディレクトリ")
38.         If pos > 0 Then
39.             FolderName = Trim(Left(var_buf(i), pos – 1))
40.         End If
41.         pos = InStr(var_buf(i), " “)
42.         If pos > 0 Then
43.             wstr1 = Trim(Left(var_buf(i), pos – 1))
44.             wstr0 = Trim(Mid(var_buf(i), pos + 1))
45.             If IsDate(wstr1) = True Then
46.                 TimeStamp = wstr1
47.                 pos = InStr(wstr0, " “)
48.                 If pos > 0 Then
49.                     wstr1 = Trim(Left(wstr0, pos – 1))
50.                     wstr0 = Trim(Mid(wstr0, pos + 1))
51.                     FileSize = wstr1
52.                     FileName = wstr0
53.                     rcnt = rcnt + 1
54.                     sht.Cells(rcnt, 1) = FolderName
55.                     sht.Cells(rcnt, 2) = FileName
56.                     sht.Cells(rcnt, 3) = FileSize
57.                     sht.Cells(rcnt, 4) = TimeStamp
58.                 End If
59.             End If
60.         End If
61.     Next i
62.     Application.ScreenUpdating = True
63. End Sub

■WshShellオブジェクトを利用した、ファイル一覧ツール

WshShellオブジェクトを利用すれば、予めdirコマンドを実行することなく、Excel VBAからdirコマンドを実行することができます。

WshShellオブジェクトはMicrosoftから提供されている、Windows上でスクリプトを実行するためのオブジェクトで、Excel VBAからコマンド・プロンプトを実行する場合は、ExecメソッドまたはRunメソッドを使用します。
⇒WshShellオブジェクトの詳細については、Excel VBAで実用ツール（PDFファイル編）を参照して下さい。

Execメソッドの使用法

WshShellオブジェクトのExecメソッドは、以下のように定義されています。

• Function Exec(Command As String) As WshExec

引数Commandには、実行したいコマンドを指定すれば良いのですが、dirコマンドを実行したい場合は「"%ComSpec% /c dir フォルダ名 /s"」のように指定します。

ここでComSpecは、コマンド・インタープリタ・プログラムのパスを示す環境変数で、コマンド・プロンプトでechoコマンドまたはsetコマンドを実行すると、下図のように内容を表示することができます。

• >echo %comspec%
• C:\WINDOWS\system32\cmd.exe
• >set comspec
• ComSpec=C:\WINDOWS\system32\cmd.exe

また、コマンド・プロンプトで「%comspec% /?」を実行すると、コマンド・インタープリタ(cmd.exe)の使用法を表示することができます。

• >%comspec% /?
• Windows コマンド インタープリターの新しいインスタンスを開始します。
• CMD [/A | /U] [/Q] [/D] [/E:ON | /E:OFF] [/F:ON | /F:OFF] [/V:ON | /V:OFF]
• [[/S] [/C | /K] 文字列]
• /C “文字列" に指定されたコマンドを実行した後、終了します。
• /K “文字列" に指定されたコマンドを実行しますが、終了しません。
• (以下省略)

WshExecオブジェクトの詳細

Exceメソッドで返されるWshExecオブジェクトのメソッドおよびプロパティは下表の通りです。

(WshExecオブジェクトのメソッドとプロパティ)

ExitCodeプロパティ(読み取り専用)
説明	実行したスクリプトまたはプログラムの終了コードを取得
定義	Property ExitCode() As Long
ProcessIDプロパティ(読み取り専用)
説明	起動されたプロセスのプロセスIDを取得
定義	Property ProcessID() As Long
Statusプロパティ(読み取り専用)
説明	実行したスクリプトまたはプログラムステータスを取得 0:WshRunning 1:WshFinished 2:WshFailed
定義	Property Status() As WshExecStatus
StdErrプロパティ(読み取り専用)
説明	StdErr出力ストリームを取得
定義	Property StdErr() As TextStream
StdInプロパティ(読み取り専用)
説明	StdIn入力ストリームを取得
定義	Property StdIn() As TextStream
StdOutプロパティ(読み取り専用)
説明	StdOut出力ストリームを取得
定義	Property StdOut() As TextStream
Terminateメソッド
説明	開始したプロセスを終了する
定義	Sub Terminate()

TextStreamオブジェクトの詳細

StdErrプロパティ、StdInプロパティ、StdOutプロパティで返されるTextStreamオブジェクトのメソッドおよびプロパティは下表の通りです。

(TextStreamオブジェクトのメソッドとプロパティ)

AtEndOfLineプロパティ(読み取り専用)
説明	TextStreamファイルの行末にファイル・ポインタがあるかどうかを取得 True:ファイル・ポインタが行末マーカーの直前にある False:ファイル・ポインタが行末マーカーの直前にない
定義	Property AtEndOfLine() As Boolean
AtEndOfStreamプロパティ(読み取り専用)
説明	TextStreamファイルの末尾にファイル・ポインタがあるかどうかを取得 True:ファイル・ポインタがファイルの末尾にある False:ファイル・ポインタがファイルの末尾にない
定義	Property AtEndOfStream() As Boolean
Closeメソッド
説明	開いているTextStreamファイルを閉じる
定義	Sub Close()
Columnプロパティ(読み取り専用)
説明	TextStreamファイル内の現在の文字位置の列番号を取得
定義	Property Column() As Long
Lineプロパティ(読み取り専用)
説明	TextStreamファイル内の現在の行番号を取得
定義	Property Line() As Long
Readメソッド
説明	TextStreamファイルから指定した数の文字を読み取る
定義	Function Read(Characters As Long) As String
ReadAllメソッド
説明	TextStreamファイル全体を読み取る
定義	Function ReadAll() As String
ReadLineメソッド
説明	TextStreamファイルから行全体(改行文字の前まで)を読み取る
定義	Function ReadLine() As String
Skipメソッド
説明	TextStreamファイルを読み込むときに、指定された数の文字をスキップする
定義	Sub Skip(Characters As Long)
SkipLineメソッド
説明	TextStreamファイルを読むときに、次の行をスキップする
定義	Sub SkipLine()
Writeメソッド
説明	指定した文字列をTextStreamファイルに書き込む
定義	Sub Write(Text As String)
WriteBlankLinesメソッド
説明	指定した数の改行文字を、TextStreamファイルに書き込む
定義	Sub WriteBlankLines(Lines As Long)
WriteLineメソッド
説明	指定された文字列および改行文字をTextStreamファイルに書き込む
定義	Sub WriteLine([Text As String])

サンプル・プログラム(4)～Execメソッドでdirコマンドを実行

WshShellオブジェクトのExceメソッドでdirコマンドを実行して、出力結果をリダイレクトしてテキスト・ファイルに出力し、そのテキスト・ファイルを入力してファイル一覧を表示するツールです。

行番号29でWshShellオブジェクトをインスタンス化した後、行番号30でExecメソッドを実行し、行番号31～33でdirコマンドの完了を待っています。
行番号36以降は、サンプル・プログラム(3)の行番号28以降の処理と同じで、行番号37でdirコマンドの出力結果ファイルをバイナリ・モードでオープン、行番号38で入力エリアを確保、行番号39でファイル全体を読み込み、行番号40でファイルをクローズした後、行番号41で読み込んだbyte型の配列をstring型の配列に変換し、行番号42で行単位に分割して配列に格納しています。
行番号44～69の繰返し処理では、行番号45～48でフォルダ名を退避したうえ、ファイル単位の情報を取得しており、行番号54で更新日時、行番号59でファイル・サイズ、行番号60でファイル名を退避し、行番号62～65でExcelシートにセットしています。

1. Dim sht As Worksheet
2. Dim wsh As IWshRuntimeLibrary.WshShell
3. Dim res As WshExec
4. Dim buf() As Byte
5. Dim var_buf() As String
6. Dim str_buf As String
7. Dim FolderName As String
8. Dim FileName As String
9. Dim FileSize As String
10. Dim TimeStamp As Date
11. Dim wstr0 As String
12. Dim wstr1 As String
13. Dim num As Integer
14. Dim pos As Integer
15. Dim rcnt As Long
17. Private Sub Sample4()
18.     Application.ScreenUpdating = False
19.     Set sht = ActiveSheet
20.     sht.Cells.Clear
21.     sht.Range(“A1") = “フォルダ名"
22.     sht.Range(“B1") = “ファイル名"
23.     sht.Range(“C1") = “サイズ"
24.     sht.Range(“D1") = “更新日時"
25.     sht.Range(“A1:D1").Interior.Color = RGB(127, 127, 127)
26.     sht.Range(“A1:D1").Font.Bold = True
27.     sht.Range(“A1:D1").HorizontalAlignment = xlCenter
28.     rcnt = 1
29.     Set wsh = New IWshRuntimeLibrary.WshShell
30.     Set res = wsh.Exec(“%ComSpec% /c dir C:\work /s >C:\work\xxx.txt")
31.     Do While res.Status = 0
32.         DoEvents
33.     Loop
34.     Set res = Nothing
35.     Set wsh = Nothing
36.     num = FreeFile
37.     Open “C:\work\xxx.txt" For Binary As #num
38.     ReDim buf(LOF(num))
39.     Get #num, , buf
40.     Close #num
41.     str_Uni = StrConv(buf(), vbUnicode)
42.     var_buf = Split(str_Uni, vbCrLf)
44.     For i = LBound(var_buf) To UBound(var_buf)
45.         pos = InStr(var_buf(i), “のディレクトリ")
46.         If pos > 0 Then
47.             FolderName = Trim(Left(var_buf(i), pos – 1))
48.         End If
49.         pos = InStr(var_buf(i), " “)
50.         If pos > 0 Then
51.             wstr1 = Trim(Left(var_buf(i), pos – 1))
52.             wstr0 = Trim(Mid(var_buf(i), pos + 1))
53.             If IsDate(wstr1) = True Then
54.                 TimeStamp = wstr1
55.                 pos = InStr(wstr0, " “)
56.                 If pos > 0 Then
57.                     wstr1 = Trim(Left(wstr0, pos – 1))
58.                     wstr0 = Trim(Mid(wstr0, pos + 1))
59.                     FileSize = wstr1
60.                     FileName = wstr0
61.                     rcnt = rcnt + 1
62.                     sht.Cells(rcnt, 1) = FolderName
63.                     sht.Cells(rcnt, 2) = FileName
64.                     sht.Cells(rcnt, 3) = FileSize
65.                     sht.Cells(rcnt, 4) = TimeStamp
66.                 End If
67.             End If
68.         End If
69.     Next i
70.     Application.ScreenUpdating = True
71. End Sub

サンプル・プログラム(5)～WshExecオブジェクトのStdOutプロパティを利用

dirコマンドの出力結果の容量が小さければ、テキスト・ファイルにリダイレクトすることなく、WshExecオブジェクトのStdOutプロパティを利用して、ファイル一覧を表示することも可能です。

行番号28でWshShellオブジェクトをインスタンス化した後、行番号29でExecメソッドを実行し、行番号30～32でdirコマンドの完了を待ち、行番号33でWshShellオブジェクトのStdOutプロパティをTextStreamオブジェクトのReadAllメソッドを使用して変数に読込み、行番号34で行単位に分割して配列に格納しています。
行番号38～63の繰返し処理では、行番号39～42でフォルダ名を退避したうえ、ファイル単位の情報を取得しており、行番号48で更新日時、行番号53でファイル・サイズ、行番号54でファイル名を退避し、行番号56～59でExcelシートにセットしています。

1. Dim sht As Worksheet
2. Dim wsh As IWshRuntimeLibrary.WshShell
3. Dim res As WshExec
4. Dim buf As String
5. Dim str_buf As String
6. Dim FolderName As String
7. Dim FileName As String
8. Dim FileSize As String
9. Dim TimeStamp As Date
10. Dim wstr0 As String
11. Dim wstr1 As String
12. Dim num As Integer
13. Dim pos As Integer
14. Dim rcnt As Long
16. Private Sub Sample5()
17.     Application.ScreenUpdating = False
18.     Set sht = ActiveSheet
19.     sht.Cells.Clear
20.     sht.Range(“A1") = “フォルダ名"
21.     sht.Range(“B1") = “ファイル名"
22.     sht.Range(“C1") = “サイズ"
23.     sht.Range(“D1") = “更新日時"
24.     sht.Range(“A1:D1").Interior.Color = RGB(127, 127, 127)
25.     sht.Range(“A1:D1").Font.Bold = True
26.     sht.Range(“A1:D1").HorizontalAlignment = xlCenter
27.     rcnt = 1
28.     Set wsh = New IWshRuntimeLibrary.WshShell
29.     Set res = wsh.Exec(“%ComSpec% /c dir C:\work /s")
30.     Do While res.Status = 0
31.         DoEvents
32.     Loop
33.     buf = res.StdOut.ReadAll
34.     var_buf = Split(buf, vbCrLf)
35.     Set res = Nothing
36.     Set wsh = Nothing
38.     For i = LBound(var_buf) To UBound(var_buf)
39.         pos = InStr(var_buf(i), “のディレクトリ")
40.         If pos > 0 Then
41.             FolderName = Trim(Left(var_buf(i), pos – 1))
42.         End If
43.         pos = InStr(var_buf(i), " “)
44.         If pos > 0 Then
45.             wstr1 = Trim(Left(var_buf(i), pos – 1))
46.             wstr0 = Trim(Mid(var_buf(i), pos + 1))
47.             If IsDate(wstr1) = True Then
48.                 TimeStamp = wstr1
49.                 pos = InStr(wstr0, " “)
50.                 If pos > 0 Then
51.                     wstr1 = Trim(Left(wstr0, pos – 1))
52.                     wstr0 = Trim(Mid(wstr0, pos + 1))
53.                     FileSize = wstr1
54.                     FileName = wstr0
55.                     rcnt = rcnt + 1
56.                     sht.Cells(rcnt, 1) = FolderName
57.                     sht.Cells(rcnt, 2) = FileName
58.                     sht.Cells(rcnt, 3) = FileSize
59.                     sht.Cells(rcnt, 4) = TimeStamp
60.                 End If
61.             End If
62.         End If
63.     Next i
64.     Application.ScreenUpdating = True
65. End Sub

Runメソッドの使用法

WshShellオブジェクトのRunメソッドは、以下のように定義されています。

• Function Run(Command As String, [WindowStyle As Variant], [WaitOnReturn As Variant]) As Integer

Runメソッド実行時の戻り値は、実行したプログラムの終了コードです。
引数として指定できる項目は下表の通りで、指定必須の引数はCommandだけです。

(Runメソッドの引数)

引数	説明
Command(必須)	実行するコマンドを指定(注) (注)パスに空白を含む場合は全体を""で囲む必要があるため、プログラム上は「"""C:\～"""」のように記述します。 (Execメソッドの場合は、そのような考慮が不要です)
WindowStyle	ウィンドウのスタイルを指定
WaitOnReturn	起動したコマンドの終了待ちをするかどうかを指定 True:コマンドの終了を待つ False:コマンドの終了を待たない

WindowStyle引数に指定できる値は、下表の通りです。

(WindowStyle引数に指定できる値)

値	内容
0	ウィンドウを非表示にし、別のウィンドウをアクティブにする
1	ウィンドウをアクティブにして表示する (アプリケーションでウィンドウを最初に表示するときには、このフラグを指定)
2	ウィンドウをアクティブにし、最小化ウィンドウとして表示する
3	ウィンドウをアクティブにし、最大化ウィンドウとして表示する
4	ウィンドウを最新のサイズと位置で表示する
5	ウィンドウをアクティブにし、現在のサイズと位置で表示する
6	指定したウィンドウを最小化し、Zオーダー上で次に上位となるウィンドウをアクティブにする
7	ウィンドウを最小化ウィンドウとして表示する
8	ウィンドウを現在の状態で表示する
9	ウィンドウをアクティブにして表示する (アプリケーションで最小化ウィンドウを復元するときには、このフラグを指定)
10	アプリケーションを起動したプログラムの状態に基づいて、表示状態を設定する

サンプル・プログラム(6)～Runメソッドでdirコマンドを実行

WshShellオブジェクトのRunメソッドでdirコマンドを実行して、出力結果をリダイレクトしてテキスト・ファイルに出力し、そのテキスト・ファイルを入力してファイル一覧を表示するツール(サンプル・プログラム(4)のExecメソッドをRunメソッドに置換えたツール)です。

行番号29でWshShellオブジェクトをインスタンス化した後、行番号30でRunメソッドを実行しています。
行番号40～65の繰返し処理では、行番号41～44でフォルダ名を退避したうえ、ファイル単位の情報を取得しており、行番号50で更新日時、行番号55でファイル・サイズ、行番号56でファイル名を退避し、行番号58～61でExcelシートにセットしています。

1. Dim sht As Worksheet
2. Dim wsh As IWshRuntimeLibrary.WshShell
3. Dim buf() As Byte
4. Dim var_buf
5. Dim str_buf As String
6. Dim FolderName As String
7. Dim FileName As String
8. Dim FileSize As String
9. Dim TimeStamp As Date
10. Dim wstr0 As String
11. Dim wstr1 As String
12. Dim num As Integer
13. Dim pos As Integer
14. Dim rcnt As Long
15. Dim i As Integer
17. Private Sub Sample6()
18.     Application.ScreenUpdating = False
19.     Set sht = ActiveSheet
20.     sht.Cells.Clear
21.     sht.Range(“A1") = “フォルダ名"
22.     sht.Range(“B1") = “ファイル名"
23.     sht.Range(“C1") = “サイズ"
24.     sht.Range(“D1") = “更新日時"
25.     sht.Range(“A1:D1").Interior.Color = RGB(127, 127, 127)
26.     sht.Range(“A1:D1").Font.Bold = True
27.     sht.Range(“A1:D1").HorizontalAlignment = xlCenter
28.     rcnt = 1
29.     Set wsh = New IWshRuntimeLibrary.WshShell
30.     wsh.Run “%ComSpec% /c dir C:\work /s >C:\work\xxx.txt", WaitOnReturn:=True
31.     Set wsh = Nothing
32.     num = FreeFile
33.     Open “C:\work\xxx.txt" For Binary As #num
34.     ReDim buf(LOF(num))
35.     Get #num, , buf
36.     Close #num
37.     str_Uni = StrConv(buf(), vbUnicode)
38.     var_buf = Split(str_Uni, vbCrLf)
40.     For i = LBound(var_buf) To UBound(var_buf)
41.         pos = InStr(var_buf(i), “のディレクトリ")
42.         If pos > 0 Then
43.             FolderName = Trim(Left(var_buf(i), pos – 1))
44.         End If
45.         pos = InStr(var_buf(i), " “)
46.         If pos > 0 Then
47.             wstr1 = Trim(Left(var_buf(i), pos – 1))
48.             wstr0 = Trim(Mid(var_buf(i), pos + 1))
49.             If IsDate(wstr1) = True Then
50.                 TimeStamp = wstr1
51.                 pos = InStr(wstr0, " “)
52.                 If pos > 0 Then
53.                     wstr1 = Trim(Left(wstr0, pos – 1))
54.                     wstr0 = Trim(Mid(wstr0, pos + 1))
55.                     FileSize = wstr1
56.                     FileName = wstr0
57.                     rcnt = rcnt + 1
58.                     sht.Cells(rcnt, 1) = FolderName
59.                     sht.Cells(rcnt, 2) = FileName
60.                     sht.Cells(rcnt, 3) = FileSize
61.                     sht.Cells(rcnt, 4) = TimeStamp
62.                 End If
63.             End If
64.         End If
65.     Next i
66.     Application.ScreenUpdating = True
67. End Sub

サンプル・プログラム(7)～フォルダを階層別に表示し、Summaryを作成

サンプル・プログラム(6)を基に、フォルダを階層別に表示し、下図のイメージでSummaryを作成するように修正したツールです(このサンプル・プログラムでは、4階層で集計しています)。

(Summaryのイメージ)

フォルダ名				サイズ
C:	xxx	yyy	zzz	nnnnn

行番号20～40は、サンプル・プログラム(6)の行番号18～38の処理とほとんど同じですが、サンプル・プログラム(6)がフォルダ名をA列としているのに対して、このツールではA列～T列としています。
行番号42～73の繰返し処理もサンプル・プログラム(6)とほとんど同じですが、行番号45でフォルダ名を退避した後、行番号46で階層ごとに分割してテーブルに格納し、行番号62～66でフォルダ名の各階層をExcelシートに表示しています。

行番号75以降がSumarryを作成する処理で、行番号84～95の繰返し処理でセットしたファイル・サイズを集計して表示しています。

1. Dim sht1, sht2 As Worksheet
2. Dim wsh As IWshRuntimeLibrary.WshShell
3. Dim buf() As Byte
4. Dim var_buf
5. Dim str_buf As String
6. Dim FolderName As String
7. Dim FileName As String
8. Dim FileSize As String
9. Dim TimeStamp As Date
10. Dim wstr0 As String
11. Dim wstr1 As String
12. Dim cTbl() As String
13. Dim num As Integer
14. Dim pos As Integer
15. Dim rcnt As Long
16. Dim cCnt As Integer
17. Dim i As Integer
19. Private Sub Sample7()
20.     Application.ScreenUpdating = False
21.     Set sht1 = ActiveSheet
22.     sht1.Cells.Clear
23.     sht1.Range(“A1") = “フォルダ名"
24.     sht1.Range(“U1") = “ファイル名"
25.     sht1.Range(“V1") = “サイズ"
26.     sht1.Range(“W1") = “更新日時"
27.     sht1.Range(“A1:W1").Interior.Color = RGB(127, 127, 127)
28.     sht1.Range(“A1:W1").Font.Bold = True
29.     sht1.Range(“A1:W1").HorizontalAlignment = xlCenter
30.      rcnt = 1
31.     Set wsh = New IWshRuntimeLibrary.WshShell
32.     wsh.Run “%ComSpec% /c dir C:\work /s >C:\work\dirtest.txt", WaitOnReturn:=True
33.     Set wsh = Nothing
34.     num = FreeFile
35.     Open “C:\work\dirtest.txt" For Binary As #num
36.     ReDim buf(LOF(num))
37.     Get #num, , buf
38.     Close #num
39.     str_Uni = StrConv(buf(), vbUnicode)
40.     var_buf = Split(str_Uni, vbCrLf)
42.     For i = 1 To UBound(var_buf)
43.         pos = InStr(var_buf(i), “のディレクトリ")
44.         If pos > 0 Then
45.             FolderName = Trim(Left(var_buf(i), pos – 1))
46.             cTbl = Split(FolderName, “\")
47.         End If
48.         pos = InStr(var_buf(i), " “)
49.         If pos > 0 Then
50.             wstr1 = Trim(Left(var_buf(i), pos – 1))
51.             wstr0 = Trim(Mid(var_buf(i), pos + 1))
52.             If IsDate(wstr1) = True Then
53.                 TimeStamp = wstr1
54.                 pos = InStr(wstr0, " “)
55.                 If pos > 0 Then
56.                     wstr1 = Trim(Left(wstr0, pos – 1))
57.                     wstr0 = Trim(Mid(wstr0, pos + 1))
58.                     FileSize = wstr1
59.                     FileName = wstr0
60.                     rcnt = rcnt + 1
62.                     cCnt = 0
63.                     For j = LBound(cTbl) To UBound(cTbl)
64.                         cCnt = cCnt + 1
65.                         sht1.Cells(rcnt, cCnt) = cTbl(j)
66.                     Next j
67.                     sht1.Cells(rcnt, 21) = FileName
68.                     sht1.Cells(rcnt, 22) = FileSize
69.                     sht1.Cells(rcnt, 23) = TimeStamp
70.                 End If
71.             End If
72.         End If
73.     Next i
75.     Set sht2 = Worksheets(“Summary")
76.     sht2.Cells.Clear
77.     sht2.Range(“A1") = “フォルダ名"
78.     sht2.Range(“E1") = “サイズ"
79.     sht2.Range(“A1:E1").Interior.Color = RGB(127, 127, 127)
80.     sht2.Range(“A1:E1").Font.Bold = True
81.     sht2.Range(“A1:E1").HorizontalAlignment = xlCenter
82.     sht2.Range(“A1:D1").Merge
83.     rcnt = 1
84.     For i = 2 To sht1.Cells(sht1.Rows.Count, 1).End(xlUp).Row
85.         If (sht2.Cells(rcnt, 1) = sht1.Cells(i, 1)) And (sht2.Cells(rcnt, 2) = sht1.Cells(i, 2)) And (sht2.Cells(rcnt, 3) = sht1.Cells(i, 3)) And (sht2.Cells(rcnt, 4) = sht1.Cells(i, 4)) Then
86.             sht2.Cells(rcnt, 5) = sht2.Cells(rcnt, 5) + sht1.Cells(i, 22)
87.         Else
88.             rcnt = rcnt + 1
89.             sht2.Cells(rcnt, 1) = sht1.Cells(i, 1)
90.             sht2.Cells(rcnt, 2) = sht1.Cells(i, 2)
91.             sht2.Cells(rcnt, 3) = sht1.Cells(i, 3)
92.             sht2.Cells(rcnt, 4) = sht1.Cells(i, 4)
93.             sht2.Cells(rcnt, 5) = sht1.Cells(i, 22)
94.         End If
95.     Next i
96.     Application.ScreenUpdating = True
97. End Sub

（おまけ）サンプル・プログラム(8)～Runメソッドでzipファイルを解凍

WshShellオブジェクトのRunメソッドでコマンドを実行する場合、実行形式以外のファイルを指定すると、そのファイルの種類(拡張子)に関連付けられたアプリを実行することができます。

以下のサンプル・プログラムは、指定したフォルダ直下のzipファイルを解凍するツールです。
(zipファイルをクリックすると解凍処理が実行されるように、予め解凍ツールを設定しておく必要があります)

1. Dim fso As FileSystemObject
2. Dim wsh As IWshRuntimeLibrary.WshShell
3. Dim f As File
5. Private Sub Sample8()
6.     Set fso = New FileSystemObject
7.     Set wsh = New IWshRuntimeLibrary.WshShell
8.     For Each f In fso.GetFolder(“C:\work\test").Files
9.         If fso.GetExtensionName(f.path) = “zip" Then
10.             wsh.Run f.path
11.         End If
12.     Next f
13.     Set f = Nothing
14.     Set wsh = Nothing
15.     Set fso = Nothing
16. End Sub