VBAを使ったWordのプロパティ(詳細情報)抽出

まだディレクトリの再帰処理が終わっていませんが
とりあえず，もう5回くらいオリジナルソースを無くしてイヤになったので
こちらにバックアップとして残しておこうかと．
ただ，ソースを作る際に参考にした方々のサイト・ソースが
ほとんどどれがどれだか分からなくなってしまったのが残念・・・

Excel上から呼び出して，Excelが存在しているディレクトリのWordファイルを読み出します．

Private Sub btnAction_Click()
    MsgBox "これより，CWD内のWordプロパティ情報を取得します．"
    WordProperty
End Sub

Sub WordProperty()
Dim Msg As String
Dim FileName As String
Dim FilePath As String


FilePath = Application.ActiveWorkbook.Path

Msg = " ディレクトリ=" + FilePath + "のファイルプロパティリストを作成します。"
MsgBox Msg
Application.ScreenUpdating = False

Worksheets("filelist").Select
Range("A1:IV65536").Clear
Range("A1").Value = FilePath
Range("A2").Value = "ファイル名"
Range("B2").Value = "作成者"
Range("C2").Value = "改訂番号(リビジョン)"
Range("D2").Value = "コンテンツの作成日時"
Range("E2").Value = "前回保存日時"
Range("F2").Value = "総編集時間"
Range("G2").Value = "ページ数"
Range("H2").Value = "文字数"
Range("I2").Value = "行数"
Range("J2").Value = "段落数"
Range("K2").Value = "バイト数"



Set WordApp = CreateObject("word.application")
WordApp.Visible = True

FileName = Dir(FilePath & "\*.doc")
i = 3
  
Do While FileName <> ""

    Set Worddoc = WordApp.Documents.Open(FilePath & "\" & FileName, ReadOnly:=True)
    Rem Repaginateしないと正確なページ数は取れない
    Worddoc.Repaginate
    
    Range("A" & i).Value = FileName
    Range("B" & i).Value = Worddoc.BuiltinDocumentProperties("Author")
    Range("C" & i).Value = Worddoc.BuiltinDocumentProperties("Revision number")
    Range("D" & i).Value = Str(Worddoc.BuiltinDocumentProperties("Creation date"))
    Range("E" & i).Value = Str(Worddoc.BuiltinDocumentProperties("Last save time"))
    Range("F" & i).Value = Worddoc.BuiltinDocumentProperties("Total editing time")
    Range("G" & i).Value = Worddoc.BuiltinDocumentProperties("Number of pages")
    Range("H" & i).Value = Worddoc.BuiltinDocumentProperties("Number of characters")
    Range("I" & i).Value = Worddoc.BuiltinDocumentProperties("Number of lines")
    Range("J" & i).Value = Worddoc.BuiltinDocumentProperties("Number of paragraphs")
    Range("K" & i).Value = Worddoc.BuiltinDocumentProperties(22)
    i = i + 1
    Worddoc.Close SaveChanges:=False
    FileName = Dir()
Loop

WordApp.Quit SaveChanges:=False

'オブジェクトのクリア
Set Worddoc = Nothing
Set WordApp = Nothing

End Sub



Private Sub FileDisp(strPath, i)
    Set objFs = CreateObject("Scripting.FileSystemObject")
    Set objFld = objFs.GetFolder(strPath)
    Set objWord = CreateObject("Word.Application")
    
    For Each objFl In objFld.Files

        Set objDoc = objWord.Documents.Open(objFl.Path)
        shtFile.Cells(i, 2) = objFs.GetBaseName(objFl.Path)
        shtFile.Cells(i, 3) = objFl.ParentFolder.Path
        shtFile.Cells(i, 4) = Int(objFl.Size / 1024)
        shtFile.Cells(i, 5) = objFl.Type
        shtFile.Cells(i, 6) = objFl.DateCreated
        shtFile.Cells(i, 7) = objFl.DateLastAccessed
        shtFile.Cells(i, 8) = objFl.DateLastModified
        shtFile.Cells(i, 9) = objDoc.BuiltinDocumentProperties(14)
        i = i + 1
        objDoc.Close
    Next
    For Each objSub In objFld.SubFolders
        FileDisp objSub.Path, i
    Next
End Sub

これを作る際に調べたのが
・Wordのページ番号を取得するには，Repaginateをしないとダメ
・この方法はかなり遅い．高速化を目指すなら
dsofile.dllを使うと良い．

しかし，VBAってわかりづらいなー・・・
いきなりモノを作ろうとしたのが原因なのは確定的に明らかなのですが．