word page counter

Option Explicit
Call Main()
Sub Main()

Dim out, folderPath, fso, ts

' パラメタを取得
If Wscript.Arguments.Count = 0 Then
folderPath = "."
Else
folderPath = Wscript.Arguments(0)
End If

Set fso = CreateObject("Scripting.FileSystemObject")

' サブフォルダに対して、再帰的に処理する
out = WordPageCounter(fso, fso.GetFolder(folderPath))

' 検索結果をCSVファイルに出力
Set ts = fso.CreateTextFile(folderPath & "\" & "WordPageCounter.csv")
ts.WriteLine(out)
ts.close
Set ts = Nothing

End Sub

' サブティレクト内のファイル一覧を取得する
Function WordPageCounter(fso, folder)

Dim file, returnValue, Subfolder

returnValue = ""

' 現在のフォルダ配下のwordファイルを探す
For Each file in folder.Files
returnValue = returnValue & BuiltInDocProperty(fso, file.path)
Next

' folder配下のフォルダを列挙する
For Each Subfolder in folder.SubFolders
' 再帰呼び出し
returnValue = returnValue & WordPageCounter(fso, Subfolder)
Next

WordPageCounter = returnValue

End Function

Function BuiltInDocProperty(fso, filepath)

Dim ext
ext = UCase(fso.GetExtensionName(filepath))
' wordファイル以外は何もしない
If Not (UCase(ext) = "DOC" OR ext = "DOCX") Then
Exit Function
End If

' wordアプリケーションを起動
Dim wordApp : Set wordApp = WScript.CreateObject("Word.Application")
' wordファイルを開く
Dim doc : Set doc = wordApp.Documents.Open(filepath)

' for debug
WScript.Echo filepath & "," & doc.BuiltInDocumentProperties(14)

' ファイル名、ページ数をカンマ区切りにして返す
BuiltInDocProperty = filepath & "," & doc.BuiltInDocumentProperties(14) & vbNewLine

' wordアプリケーションの終了
doc.Close
Set doc = Nothing
wordApp.Quit
Set wordApp = Nothing
End Function