複数のワードファイルで合計ページ数を知りたい

質問

あるフォルダに数十個というWordファイルがあり、その
ファイル一つ一つを開いてページ数を調べたりファイル１つ１つの
プロパティを調べてページ数を加えていくのは非常に手間なので
できれば「このフォルダにあるWordファイルの総ページ数を知りたい」
という要求に対して一発で解決したいと思っています。
各Wordファイルのプロパティを一覧化してくれたり、
Wordファイル分ループで回ってそれらを足しこんでくれる
ツールなどは無いでしょうか。
Wordはバージョン2003でOSはXP SP2を使っています。

回答No.2

temtecomai2 · ベストアンサー

ツールは知りません。
質問者さんの立場と要求者との関係もわかりません。
もし質問者さんがご自分でスクリプトを書く覚悟があるのなら下記の VBScript をお試し下さい。

空のテキストファイルに以下のコードをコピペして保存し、そのテキストファイルの拡張子を vbs に変更してからファイルをダブルクリックしてみてください。
フォルダ選択ダイアログが表示され、Word ファイルが入っているフォルダを選択して [OK] をクリックすると Word が実行され、次々にファイルを開いては閉じるを繰り返し、最終的に合計ページ数が表示されます。

Option Explicit

Const wdStatisticPages = 2

Dim targetPath
targetPath = GetTargetDir

If TargetPathExists(targetPath) Then
wscript.Echo "ページ合計: " & CountPage(targetPath)
Else
wscript.Echo "フォルダ パスが不正です"
End If

Function GetTargetDir()
Dim objShell, objFolder
Set objShell = WScript.CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "フォルダを選択", 0)
If Not objFolder Is Nothing Then
GetTargetDir = objFolder.Items.Item.Path
End If
Set objFolder = Nothing
Set objShell = Nothing
End Function

Function TargetPathExists(aTargetPath)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
TargetPathExists = fso.FolderExists(aTargetPath)
End Function

Function CountPage(aTargetPath)
Dim strComputer
strComputer = "."

Dim objWMIService
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

Dim colFiles
Set colFiles = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='" & aTargetPath & "'} Where " & _
"ResultClass = CIM_DataFile")

Dim objWord
Set objWord = CreateObject("Word.Application")
objWord.Visible = True

Dim intPages
intPages = 0

Dim objFile
For Each objFile in colFiles
If objFile.Extension = "doc" Then
Dim objDoc
Set objDoc = objWord.Documents.Open(objFile.Name)
intPages = intPages + objDoc.ComputeStatistics(wdStatisticPages)
objDoc.Saved = True
objDoc.Close
End If
Next

objWord.Quit

CountPage = intPages
End Function

お礼

VBスクリプトをさくっと書ける人にとっては
ツール化するまでもないからツールが無いんですかね...
内容をがんばって把握してから実施してみたいと思います。
ありがとうございました。

補足

こちらの方はWordファイルのプロパティを拾ってきているようで
プロパティのページ数と実際のページ数が違っていれば
実際のページ数を正確に拾ってきてくれないようです。
残念です。

回答No.4

KenKen_SP

> こちらの方はWordファイルのプロパティを拾ってきているようで
> プロパティのページ数と実際のページ数が違っていれば
> 実際のページ数を正確に拾ってきてくれないようです。

その通りです。ファイルのプロパティーを列挙しています。したがって

fn = Dir(f.Self.Path & "\*.doc")

の拡張子部分を変更すると、Excel ファイルなどにも応用できますし、
ちょこっとコードを変更すると、MP3ファイルのビットレートやID3タグ
の内容なんかも列挙することができます。

　# 詳しくは GetDetailsOf で検索すると情報が得られます

WORD ファイルについて、実際のページ数とは異なる場合がある点は私も
認識しておりましたが、既に #1 の良回答があったにも関わらず回答した
意図は、処理速度に重点を置き

> 各Wordファイルのプロパティを一覧化してくれたり、

といったご希望に沿う...というものです。

> なぜ、プロパティには正しい値が入らないんですかね...

私にも詳しくはわかりませんが、プロパティーは「保存時」に更新
されるようですから、一度そのファイルを開いてから、上書き保存を行う
と正しいページ数になりますよ。

お礼

ありがとうございます。色々応用できそうですね。
ただ、お教えいただいた上書き保存を行っても
ページ数は全然変わらないですね．．．
単語数や文字数はちゃんと正しい数値が常に入っているので
肝心のページ数だけが１ページから一切変わらない状態です。
ちなみにOSもWordも当方とバージョンは同じでしょうか。
同じであれば何が違うんでしょうかねぇ．．．
当方では簡単に何文字か適当な文字を入れる→Ctrl+Enterで改ページ
を繰り返してページ数を増やしていっていますが
プロパティのページ数には全然反映されません。

回答No.3

KenKen_SP

こんばんは。

かなり適当だけど Shell の GetDetailsOf メソッドを使った例です。

Excel VBA ですよ。標準モジュールにでも貼り付けて下さい。そして、
ページ数の総合計は SUM 関数でも使って下さい。（単なる手抜きです）
では。

Public Sub EnumDocFilePropaties()

　　Const ERR_USER_CANCEL As Long = 1000
　　Const ERR_NOT_FOUND　 As Long = 1001

　　Dim oShell　 As Object
　　Dim f　　　　As Object
　　Dim fn　　　 As String
　　Dim i　　　　As Long
　　Dim r　　　　As Long

　　On Error GoTo Err_

　　' // フォルダ選択ダイアログ
　　Set oShell = CreateObject("Shell.Application")
　　Set f = oShell.BrowseForFolder(0&, "フォルダを選んで下さい", 0&)
　　If f Is Nothing Then
　　　　Err.Raise ERR_USER_CANCEL
　　End If

　　' // 初回 Word ファイル検索
　　fn = Dir(f.Self.Path & "\*.doc")
　　If Len(fn) = 0 Then
　　　　Err.Raise ERR_NOT_FOUND, , "*.doc ファイルが無いみたい"
　　End If

　　' // 見出し作成
　　Set f = oShell.NameSpace(f.Self.Path)
　　Cells.Clear
　　r = 1
　　Application.ScreenUpdating = False
　　For i = 0 To 14
　　　　Cells(r, i + 1).Value = f.GetDetailsOf(, i)
　　Next
　　' // プロパティー値列挙
　　While Len(fn) > 0
　　　　r = r + 1
　　　　For i = 0 To 14
　　　　　　Cells(r, i + 1).Value = f.GetDetailsOf(f.ParseName(fn), i)
　　　　Next
　　　　fn = Dir()
　　Wend
　　Cells.EntireColumn.AutoFit

Bye_:
　　Set oShell = Nothing
　　Set f = Nothing
　　Exit Sub
Err_:
　　Select Case Err.Number
　　　　Case 1000 ' // User Cancel
　　　　　　Resume Bye_
　　　　Case Else ' // Other Error
　　　　　　MsgBox Err.Description, vbCritical
　　　　　　Resume Bye_
　　End Select
End Sub

お礼

VBAスクリプトをさくっと書ける人にとっては
ツール化するまでもないからツールが無いんですかね...
内容をがんばって把握してから実施してみたいと思います。
ありがとうございました。

補足

失礼しました。No.2とNo.3の方の補足を間違えてしまいました。
ExcelVBAの方がプロパティを持ってきているので正しい値が表示されないですね。
VBスクリプトの方は
Set objDoc = objWord.Documents.Open(objFile.Name)
intPages = intPages + objDoc.ComputeStatistics(wdStatisticPages)
をFor Nextで回して一つ一つファイルを開いて足しこんでいるので
正しいページが拾ってこれているようです。
なぜ、プロパティには正しい値が入らないんですかね...
temtecomai2さん、ありがとうございました。

回答No.1

dodemoii

こんばんは

外しているかもしれませんが、
エクスプローラで詳細表示した際、その項目に
「ページ数」というカテゴリも表示可能です。
表示するにはエクスプローラの「名前」「サイズ」などの
表示している所で右クリックし、「その他...」
でページ数にチェックを入れます。

これでワードのファイルならページ数が表示できます。
(但し、図を貼り付けただけのファイルなどでは正しい
ページ数が表示できないこともあるようです。
また他の形式ファイルではあまり意味が無いかも)

では。

お礼

エクスプローラで表示できる列ってカスタマイズできるんですね。
知りませんでした。
でも簡単なワードファイル作って見てみたら
画像とか入れてないのですが、
いくらページ数を増やしても表示される数字は1のまま...
プロパティから見ても1ページのままなんでWordのバグですかね...
ありがとうございました。