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

2022-02-192024-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でフォルダの下にあるサブフォルダを指定して、サブ・プロシジャを再帰呼び出ししています。

Dim sht As Worksheet
Dim fso As FileSystemObject
Dim f As File
Dim s As Folder
Dim rcnt As Long
Private Sub Sample1()
Application.ScreenUpdating = False
Set sht = ActiveSheet
sht.Cells.Clear
sht.Range(“A1") = “フォルダ名"
sht.Range(“B1") = “ファイル名"
sht.Range(“C1") = “サイズ"
sht.Range(“D1") = “更新日時"
sht.Range(“A1:D1").Interior.Color = RGB(127, 127, 127)
sht.Range(“A1:D1").Font.Bold = True
sht.Range(“A1:D1").HorizontalAlignment = xlCenter
rcnt = 1
Set fso = New FileSystemObject
Call Sample1_sub(“C:\work")
Set f = Nothing
Set s = Nothing
Set fso = Nothing
Application.ScreenUpdating = True
End Sub
Public Sub Sample1_sub(path As String)
For Each f In fso.GetFolder(path).Files
rcnt = rcnt + 1
sht.Cells(rcnt, 1) = f.ParentFolder
sht.Cells(rcnt, 2) = f.Name
sht.Cells(rcnt, 3) = f.Size
sht.Cells(rcnt, 4) = f.DateLastModified
Next f
For Each s In fso.GetFolder(path).SubFolders
Call Sample1_sub(s.path)
Next s
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シートにセットしています。

Dim sht As Worksheet
Dim buf As String
Dim FolderName As String
Dim FileName As String
Dim FileSize As String
Dim TimeStamp As Date
Dim wstr0 As String
Dim wstr1 As String
Dim num As Integer
Dim pos As Integer
Dim rcnt As Long
Private Sub Sample2()
Application.ScreenUpdating = False
Set sht = ActiveSheet
sht.Cells.Clear
sht.Range(“A1") = “フォルダ名"
sht.Range(“B1") = “ファイル名"
sht.Range(“C1") = “サイズ"
sht.Range(“D1") = “更新日時"
sht.Range(“A1:D1").Interior.Color = RGB(127, 127, 127)
sht.Range(“A1:D1").Font.Bold = True
sht.Range(“A1:D1").HorizontalAlignment = xlCenter
rcnt = 1
num = FreeFile
Open “C:\work\xxx.txt" For Input As #num
Do Until EOF(num)
Line Input #num, buf
pos = InStr(buf, “のディレクトリ")
If pos > 0 Then
FolderName = Trim(Left(buf, pos – 1))
End If
pos = InStr(buf, " “)
If pos > 0 Then
wstr1 = Trim(Left(buf, pos – 1))
wstr0 = Trim(Mid(buf, pos + 1))
If IsDate(wstr1) = True Then
TimeStamp = wstr1
pos = InStr(wstr0, " “)
If pos > 0 Then
wstr1 = Trim(Left(wstr0, pos – 1))
wstr0 = Trim(Mid(wstr0, pos + 1))
FileSize = wstr1
FileName = wstr0
rcnt = rcnt + 1
sht.Cells(rcnt, 1) = FolderName
sht.Cells(rcnt, 2) = FileName
sht.Cells(rcnt, 3) = FileSize
sht.Cells(rcnt, 4) = TimeStamp
End If
End If
End If
Loop
Close #num
Application.ScreenUpdating = True
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シートにセットしています。

Dim sht As Worksheet
Dim buf() As Byte
Dim var_buf() As String
Dim str_buf As String
Dim FolderName As String
Dim FileName As String
Dim FileSize As String
Dim TimeStamp As Date
Dim wstr0 As String
Dim wstr1 As String
Dim num As Integer
Dim pos As Integer
Dim rcnt As Long
Dim i As Integer
Private Sub Sample3()
Application.ScreenUpdating = False
Set sht = ActiveSheet
sht.Cells.Clear
sht.Range(“A1") = “フォルダ名"
sht.Range(“B1") = “ファイル名"
sht.Range(“C1") = “サイズ"
sht.Range(“D1") = “更新日時"
sht.Range(“A1:D1").Interior.Color = RGB(127, 127, 127)
sht.Range(“A1:D1").Font.Bold = True
sht.Range(“A1:D1").HorizontalAlignment = xlCenter
rcnt = 1
num = FreeFile
Open “C:\work\xxx.txt" For Binary As #num
ReDim buf(LOF(num))
Get #num, , buf
Close #num
str_Uni = StrConv(buf(), vbUnicode)
var_buf = Split(str_Uni, vbCrLf)
For i = LBound(var_buf) To UBound(var_buf)
pos = InStr(var_buf(i), “のディレクトリ")
If pos > 0 Then
FolderName = Trim(Left(var_buf(i), pos – 1))
End If
pos = InStr(var_buf(i), " “)
If pos > 0 Then
wstr1 = Trim(Left(var_buf(i), pos – 1))
wstr0 = Trim(Mid(var_buf(i), pos + 1))
If IsDate(wstr1) = True Then
TimeStamp = wstr1
pos = InStr(wstr0, " “)
If pos > 0 Then
wstr1 = Trim(Left(wstr0, pos – 1))
wstr0 = Trim(Mid(wstr0, pos + 1))
FileSize = wstr1
FileName = wstr0
rcnt = rcnt + 1
sht.Cells(rcnt, 1) = FolderName
sht.Cells(rcnt, 2) = FileName
sht.Cells(rcnt, 3) = FileSize
sht.Cells(rcnt, 4) = TimeStamp
End If
End If
End If
Next i
Application.ScreenUpdating = True
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シートにセットしています。

Dim sht As Worksheet
Dim wsh As IWshRuntimeLibrary.WshShell
Dim res As WshExec
Dim buf() As Byte
Dim var_buf() As String
Dim str_buf As String
Dim FolderName As String
Dim FileName As String
Dim FileSize As String
Dim TimeStamp As Date
Dim wstr0 As String
Dim wstr1 As String
Dim num As Integer
Dim pos As Integer
Dim rcnt As Long
Private Sub Sample4()
Application.ScreenUpdating = False
Set sht = ActiveSheet
sht.Cells.Clear
sht.Range(“A1") = “フォルダ名"
sht.Range(“B1") = “ファイル名"
sht.Range(“C1") = “サイズ"
sht.Range(“D1") = “更新日時"
sht.Range(“A1:D1").Interior.Color = RGB(127, 127, 127)
sht.Range(“A1:D1").Font.Bold = True
sht.Range(“A1:D1").HorizontalAlignment = xlCenter
rcnt = 1
Set wsh = New IWshRuntimeLibrary.WshShell
Set res = wsh.Exec(“%ComSpec% /c dir C:\work /s >C:\work\xxx.txt")
Do While res.Status = 0
DoEvents
Loop
Set res = Nothing
Set wsh = Nothing
num = FreeFile
Open “C:\work\xxx.txt" For Binary As #num
ReDim buf(LOF(num))
Get #num, , buf
Close #num
str_Uni = StrConv(buf(), vbUnicode)
var_buf = Split(str_Uni, vbCrLf)
For i = LBound(var_buf) To UBound(var_buf)
pos = InStr(var_buf(i), “のディレクトリ")
If pos > 0 Then
FolderName = Trim(Left(var_buf(i), pos – 1))
End If
pos = InStr(var_buf(i), " “)
If pos > 0 Then
wstr1 = Trim(Left(var_buf(i), pos – 1))
wstr0 = Trim(Mid(var_buf(i), pos + 1))
If IsDate(wstr1) = True Then
TimeStamp = wstr1
pos = InStr(wstr0, " “)
If pos > 0 Then
wstr1 = Trim(Left(wstr0, pos – 1))
wstr0 = Trim(Mid(wstr0, pos + 1))
FileSize = wstr1
FileName = wstr0
rcnt = rcnt + 1
sht.Cells(rcnt, 1) = FolderName
sht.Cells(rcnt, 2) = FileName
sht.Cells(rcnt, 3) = FileSize
sht.Cells(rcnt, 4) = TimeStamp
End If
End If
End If
Next i
Application.ScreenUpdating = True
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シートにセットしています。

Dim sht As Worksheet
Dim wsh As IWshRuntimeLibrary.WshShell
Dim res As WshExec
Dim buf As String
Dim str_buf As String
Dim FolderName As String
Dim FileName As String
Dim FileSize As String
Dim TimeStamp As Date
Dim wstr0 As String
Dim wstr1 As String
Dim num As Integer
Dim pos As Integer
Dim rcnt As Long
Private Sub Sample5()
Application.ScreenUpdating = False
Set sht = ActiveSheet
sht.Cells.Clear
sht.Range(“A1") = “フォルダ名"
sht.Range(“B1") = “ファイル名"
sht.Range(“C1") = “サイズ"
sht.Range(“D1") = “更新日時"
sht.Range(“A1:D1").Interior.Color = RGB(127, 127, 127)
sht.Range(“A1:D1").Font.Bold = True
sht.Range(“A1:D1").HorizontalAlignment = xlCenter
rcnt = 1
Set wsh = New IWshRuntimeLibrary.WshShell
Set res = wsh.Exec(“%ComSpec% /c dir C:\work /s")
Do While res.Status = 0
DoEvents
Loop
buf = res.StdOut.ReadAll
var_buf = Split(buf, vbCrLf)
Set res = Nothing
Set wsh = Nothing
For i = LBound(var_buf) To UBound(var_buf)
pos = InStr(var_buf(i), “のディレクトリ")
If pos > 0 Then
FolderName = Trim(Left(var_buf(i), pos – 1))
End If
pos = InStr(var_buf(i), " “)
If pos > 0 Then
wstr1 = Trim(Left(var_buf(i), pos – 1))
wstr0 = Trim(Mid(var_buf(i), pos + 1))
If IsDate(wstr1) = True Then
TimeStamp = wstr1
pos = InStr(wstr0, " “)
If pos > 0 Then
wstr1 = Trim(Left(wstr0, pos – 1))
wstr0 = Trim(Mid(wstr0, pos + 1))
FileSize = wstr1
FileName = wstr0
rcnt = rcnt + 1
sht.Cells(rcnt, 1) = FolderName
sht.Cells(rcnt, 2) = FileName
sht.Cells(rcnt, 3) = FileSize
sht.Cells(rcnt, 4) = TimeStamp
End If
End If
End If
Next i
Application.ScreenUpdating = True
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:コマンドの終了を待たない

引数

説明

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シートにセットしています。

Dim sht As Worksheet
Dim wsh As IWshRuntimeLibrary.WshShell
Dim buf() As Byte
Dim var_buf
Dim str_buf As String
Dim FolderName As String
Dim FileName As String
Dim FileSize As String
Dim TimeStamp As Date
Dim wstr0 As String
Dim wstr1 As String
Dim num As Integer
Dim pos As Integer
Dim rcnt As Long
Dim i As Integer
Private Sub Sample6()
Application.ScreenUpdating = False
Set sht = ActiveSheet
sht.Cells.Clear
sht.Range(“A1") = “フォルダ名"
sht.Range(“B1") = “ファイル名"
sht.Range(“C1") = “サイズ"
sht.Range(“D1") = “更新日時"
sht.Range(“A1:D1").Interior.Color = RGB(127, 127, 127)
sht.Range(“A1:D1").Font.Bold = True
sht.Range(“A1:D1").HorizontalAlignment = xlCenter
rcnt = 1
Set wsh = New IWshRuntimeLibrary.WshShell
wsh.Run “%ComSpec% /c dir C:\work /s >C:\work\xxx.txt", WaitOnReturn:=True
Set wsh = Nothing
num = FreeFile
Open “C:\work\xxx.txt" For Binary As #num
ReDim buf(LOF(num))
Get #num, , buf
Close #num
str_Uni = StrConv(buf(), vbUnicode)
var_buf = Split(str_Uni, vbCrLf)
For i = LBound(var_buf) To UBound(var_buf)
pos = InStr(var_buf(i), “のディレクトリ")
If pos > 0 Then
FolderName = Trim(Left(var_buf(i), pos – 1))
End If
pos = InStr(var_buf(i), " “)
If pos > 0 Then
wstr1 = Trim(Left(var_buf(i), pos – 1))
wstr0 = Trim(Mid(var_buf(i), pos + 1))
If IsDate(wstr1) = True Then
TimeStamp = wstr1
pos = InStr(wstr0, " “)
If pos > 0 Then
wstr1 = Trim(Left(wstr0, pos – 1))
wstr0 = Trim(Mid(wstr0, pos + 1))
FileSize = wstr1
FileName = wstr0
rcnt = rcnt + 1
sht.Cells(rcnt, 1) = FolderName
sht.Cells(rcnt, 2) = FileName
sht.Cells(rcnt, 3) = FileSize
sht.Cells(rcnt, 4) = TimeStamp
End If
End If
End If
Next i
Application.ScreenUpdating = True
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の繰返し処理でセットしたファイル・サイズを集計して表示しています。

Dim sht1, sht2 As Worksheet
Dim wsh As IWshRuntimeLibrary.WshShell
Dim buf() As Byte
Dim var_buf
Dim str_buf As String
Dim FolderName As String
Dim FileName As String
Dim FileSize As String
Dim TimeStamp As Date
Dim wstr0 As String
Dim wstr1 As String
Dim cTbl() As String
Dim num As Integer
Dim pos As Integer
Dim rcnt As Long
Dim cCnt As Integer
Dim i As Integer
Private Sub Sample7()
Application.ScreenUpdating = False
Set sht1 = ActiveSheet
sht1.Cells.Clear
sht1.Range(“A1") = “フォルダ名"
sht1.Range(“U1") = “ファイル名"
sht1.Range(“V1") = “サイズ"
sht1.Range(“W1") = “更新日時"
sht1.Range(“A1:W1").Interior.Color = RGB(127, 127, 127)
sht1.Range(“A1:W1").Font.Bold = True
sht1.Range(“A1:W1").HorizontalAlignment = xlCenter
rcnt = 1
Set wsh = New IWshRuntimeLibrary.WshShell
wsh.Run “%ComSpec% /c dir C:\work /s >C:\work\dirtest.txt", WaitOnReturn:=True
Set wsh = Nothing
num = FreeFile
Open “C:\work\dirtest.txt" For Binary As #num
ReDim buf(LOF(num))
Get #num, , buf
Close #num
str_Uni = StrConv(buf(), vbUnicode)
var_buf = Split(str_Uni, vbCrLf)
For i = 1 To UBound(var_buf)
pos = InStr(var_buf(i), “のディレクトリ")
If pos > 0 Then
FolderName = Trim(Left(var_buf(i), pos – 1))
cTbl = Split(FolderName, “\")
End If
pos = InStr(var_buf(i), " “)
If pos > 0 Then
wstr1 = Trim(Left(var_buf(i), pos – 1))
wstr0 = Trim(Mid(var_buf(i), pos + 1))
If IsDate(wstr1) = True Then
TimeStamp = wstr1
pos = InStr(wstr0, " “)
If pos > 0 Then
wstr1 = Trim(Left(wstr0, pos – 1))
wstr0 = Trim(Mid(wstr0, pos + 1))
FileSize = wstr1
FileName = wstr0
rcnt = rcnt + 1
cCnt = 0
For j = LBound(cTbl) To UBound(cTbl)
cCnt = cCnt + 1
sht1.Cells(rcnt, cCnt) = cTbl(j)
Next j
sht1.Cells(rcnt, 21) = FileName
sht1.Cells(rcnt, 22) = FileSize
sht1.Cells(rcnt, 23) = TimeStamp
End If
End If
End If
Next i
Set sht2 = Worksheets(“Summary")
sht2.Cells.Clear
sht2.Range(“A1") = “フォルダ名"
sht2.Range(“E1") = “サイズ"
sht2.Range(“A1:E1").Interior.Color = RGB(127, 127, 127)
sht2.Range(“A1:E1").Font.Bold = True
sht2.Range(“A1:E1").HorizontalAlignment = xlCenter
sht2.Range(“A1:D1").Merge
rcnt = 1
For i = 2 To sht1.Cells(sht1.Rows.Count, 1).End(xlUp).Row
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
sht2.Cells(rcnt, 5) = sht2.Cells(rcnt, 5) + sht1.Cells(i, 22)
Else
rcnt = rcnt + 1
sht2.Cells(rcnt, 1) = sht1.Cells(i, 1)
sht2.Cells(rcnt, 2) = sht1.Cells(i, 2)
sht2.Cells(rcnt, 3) = sht1.Cells(i, 3)
sht2.Cells(rcnt, 4) = sht1.Cells(i, 4)
sht2.Cells(rcnt, 5) = sht1.Cells(i, 22)
End If
Next i
Application.ScreenUpdating = True
End Sub