Excel VBAでWord/パワポ/Visioのページ数を取得する方法

Excel、Word、パワポ、Visioなどで作成した設計書の総ページ数を取得したい。そういう依頼があったので、ページ数を取得するマクロを書いてみました。
Excelから他のアプリを操作したことがなかったのでヒィヒィ言いながら調べました…。
もっとナイスでスマートな方法があれば教えてください。（できればいちいちファイルを開かないで取得したい）

⇒いきなりですが、Wordとパワポに関しては解決しました。
dsofile.dllをインストール可能な状況であれば、ファイルを開かずにページ数・スライド数が取得できます。*1
ダウンロード先：
https://www.microsoft.com/en-us/download/details.aspx?id=8422

プロパティと値の対応表は、こちらのサイトにまとめてありました。
http://www.relief.jp/itnote/archives/000487.php

ファイルを開いて値を取得する方法、ファイルを開かないで値を取得する方法両方書いておきます。

Word

ファイルを開かないでページ数を確認

Private Function get_page_cnt_word(sFile As String, sPath As String) As Long
'ページ数の取得を行う関数（Word)
'引数：処理対象のファイル名、処理対象ファイルの格納フォルダ
 
    Dim obj As Object
    
    'オブジェクトを取得
    Set obj = GetObject(sPath & "\" & sFile)
    
    'ページ数を取得
    get_page_cnt_word = obj.BuiltinDocumentProperties(14).Value
   
   'オブジェクト変数を解放
   Set obj = Nothing

End Function

ファイルを開いてページ数を確認

Private Function get_page_cnt_word(sFile As String, sPath As String) As Long
‘ページ数の取得を行う関数（Word)
'引数：処理対象のファイル名、処理対象ファイルの格納フォルダ

   Dim wdApp As Object
   Dim wdDoc As Object
   Dim lCount As Long

   Set wdApp = CreateObject(“Word.Application”)

   'ファイルオープン
   Set wdDoc = wdApp.Documents.Open(sPath & "\" & sFile)
   'ページ数取得
   lCount = wdDoc.ComputeStatistics(Statistic:=wdStatisticPages, IncludeFootnotesAndEndnotes:=True)

   'Wordを閉じる
   wdDoc.Close
   wdApp.Application.Quit

   'オブジェクト変数を解放
   Set wdDoc = Nothing
   Set wdApp = Nothing
   
      'ページ数表示
   get_page_cnt_word = lCount

End Function

この方法で実行したら、なぜかWordの文字数が取得されてしまった。参照設定を行うことで、問題なく総ページ数が取得されるようになりました。

参照設定のやりかた

Power Point

ファイルを開かないでスライド数を確認

Private Function get_page_cnt_ppt(sFile As String, sPath As String) As Long
'ページ数の取得を行う関数（パワポ)
'引数：処理対象のファイル名、処理対象ファイルの格納フォルダ
        
    Dim obj As Object
    
    'オブジェクトを取得
    Set obj = GetObject(sPath & "\" & sFile)
    
    'スライド数を取得
    get_page_cnt_ppt = obj.BuiltinDocumentProperties(25).Value
    
    Set obj = Nothing
    
End Function

ファイルを開いてスライド数を確認

Private Function get_page_cnt_ppt(sFile As String, sPath As String) As Long
'ページ数の取得を行う関数（パワポ)
'引数：処理対象のファイル名、処理対象ファイルの格納フォルダ

   Dim pp As Object
   Dim lCount As Long

   Set pp = CreateObject("PowerPoint.application”)

   With pp
      'ファイルオープン
       .Presentations.Open sPath  & "\" & sFile, ReadOnly:=True
      'スライド数取得
       lCount = .activepresentation.slides.Count
       
       'パワポを閉じる
       .Presentations(sFile).Close
       .Quit
   End With
   
   'オブジェクト変数を解放
   Set pp = Nothing
   get_page_cnt_ppt = lCount

End Function

Visio

Private Function get_page_cnt_vsd(sFile As String, sPath As String) As Long
'ページ数の取得を行う関数（visio)
'引数：処理対象のファイル名、処理対象ファイルの格納フォルダ
   Dim visio As Object
   Dim lCount As Long

   Set visio = CreateObject("Visio.Application”)

   With visio
       'ファイルオープン
       .Documents.Open sPath & "\" & sFile
       
       'シート数取得
       lCount = .ActiveDocument.Pages.Count
       
       'Visioを閉じる
       .Documents(sFile).Close
       .Quit
   End With
   
   'オブジェクト変数を解放
   Set visio = Nothing
   get_page_cnt_vsd = lCount

End Function

おまけ

PDFファイルの総ページ数は、こちらのコードを使って取得することにしました。
www.ka-net.org

Acrobat Reader11専用。Acrobat Reader DCでは動かないのかな（試してない）

関連記事

risa.hatenablog.com
risa.hatenablog.com

*1:でも、本当のページ数と異なる値が出てくることもあった…。厳密に正しい値を取りたいならば、開いて取得した方がいいのかもしれない。