広告
ある日、大量のWordファイルで作られた資料の中身を目視確認する必要に迫られました。
複数人で分担して実施するのですがファイル毎にボリューム(ページ数)が異なるためファイル数で割り振ると不公平が発生します。
そこで事前にファイル単位のページ数がわかるといいなぁということでページ数の一覧を生成するスクリプトを作ってみました。
|
1 |
[rtoc_mokuji title="" title_display="" heading="h3" list_h2_type="" list_h3_type="" display="" frame_design="" animation=""] |
ソースコード
作成したスクリプトはスクリプトを実行したディレクトリ配下にあるWordファイルを検索しページ数を取得して結果をファイル出力します。
Wordファイルのページ数はBuiltinDocumentPropertiesで取ってこれます。
下記を参考にしました。
文字コードはSJISなので注意です。(UTF-8だと実行時に日本語を扱っている行で怒られます。)
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 |
' 'VBScript File 'Character code is SJIS ' Option Explicit Call Main() ' '@func Main '@brief メイン関数 ' Sub Main() 'ファイルシステムオブジェクトの生成 Dim fso Set fso = CreateObject("Scripting.FileSystemObject") 'カレントDIR配下にあるWordファイルのページ数を取得 Dim result result = GetNumberOfWordFilePageAll(fso, fso.GetFolder(".")) '結果をファイルに出力 Dim ret ret = WriteResultToFile(fso, "result.csv", result) End Sub ' '@func GetNumberOfWordFilePageAll '@brief カレントDIRにあるWordファイルのページ数を取得する '@param[in] dir ディレクトリパス '@param[in] fso ファイルシステムオブジェクト ' Function GetNumberOfWordFilePageAll(fso, dir) Dim result result= "" ' カレントDIRにあるwordファイルのページ数を数える Dim File For Each File in dir.Files result= result& GetNumberOfWordPages(fso, File.path) Next ' カレントDIR配下にあるDIRに対して再帰的に実行する Dim Subdir For Each Subdir in dir.SubFolders ' 再帰呼び出し result= result& GetNumberOfWordFilePageAll(fso, Subdir) Next GetNumberOfWordFilePageAll = result End Function ' '@func GetNumberOfWordPages '@brief Wordファイルのページ数を取得する '@param[in] fso ファイルシステムオブジェクト '@param[in] filepath 対象ファイル ' Function GetNumberOfWordPages(fso, filepath) '拡張子のチェック(wordファイル以外は対象外) Dim ExtName ExtName = UCase(fso.GetExtensionName(filepath)) If Not (ExtName = "DOC" OR ExtName = "DOCX") Then Exit Function End If ' wordファイルを開く Dim wordApp Set wordApp = WScript.CreateObject("Word.Application") Dim doc Set doc = wordApp.Documents.Open(filepath) ' ファイル名,ページ数を返す GetNumberOfWordPages = filepath & "," & doc.BuiltInDocumentProperties(14) & vbNewLine ' wordファイルを閉じる doc.Close Set doc = Nothing wordApp.Quit Set wordApp = Nothing End Function ' @func WriteResultToFile ' @brief 処理結果をファイルに出力 ' @param[in] fso ファイルシステムオブジェクト ' @param[in] filename 出力ファイル名 ' @param[in] result 処理結果 ' Function WriteResultToFile(fso, filename, result) Dim file Set file = fso.CreateTextFile("." & "\" & filename) Dim header header = UCase("ファイル名, ページ数") file.WriteLine(header) file.WriteLine(result) file.close Set file = Nothing MsgBox "処理結果を '" & filename & "' に出力しました。" End Function |
|
1 |
実行結果
ちゃんと動作するか適当なワードファイルを用意して試してみます。
カレントにページ数が3のファイルを、サブディレクトリにページ数が1のファイルを作り配置します。
その他、Wordファイル以外を誤ってカウントしないか確認するためにダミーのテキストファイルを配置します。
こんな感じで配置しました。
ファイルの配置したらスクリプトをクリックして実行してみます。
ちゃんと動いてそうですね。
あとは記載内容のチェックもある程度自動化できればいいなぁ。
図とかは限界がありそうですが。
広告
広告
