MS-WORDファイルのプレビューを画像化

Microsoft Office WORDでドキュメント管理をしていて、過去に作成したファイルを探すのに苦労します。エクスプローラのプレビュー機能だと一件ずつ確認しないといけないので、MS Officeのマクロ(VBA)と無料アプリのImageMagickを使って、各WORD文書ファイルの1ページ目をPNG画像に変換し、HTMLでサムネイル化します。

構造

今回の構造をツリーに示すと次のようになります。expフォルダは実行のたびにスクラップアンドビルドされるサムネイル出力先フォルダです。pdfフォルダは中間ファイルであるPDFを保存するものです。このフォルダも実行のたびにスクラップアンドビルドされます。srcにはサムネイルに変換したいMicrosoft WORDファイルを入れます。拡張子docとdocxのものに対応しています。

ルートフォルダにマクロ(VBA)を記述したWORDファイルを配置します。

フォルダ構造

ROOTフォルダ
├─exp……出力フォルダ(PNG画像、HTMLファイル)
├─pdf……ワークフォルダ(中間ファイルPDF)
├─src……データフォルダ(WORDドキュメント)
└─プログラム本体.docm

処理工程

プログラム本体のマクロ(VBA)を実行します。
マクロが、srcフォルダ内のWORDファイルをPDF化し、pdfフォルダ内に中間ファイルとして出力します。
マクロが、pdfフォルダ内のPDFデータをPNG画像にする外部コマンドを実行します。
外部コマンド(Image Magick)がPDFファイルをPNG画像に変換します。
マクロが、作成したPNG画像を表示するHTMLファイルを作成します。

Image Magick

PDFからPNG画像に変換するのには無料のImage Magickを利用します。ダウンロードページより環境にあったものをダウンロードしてください。

Windwos10-32bit環境の筆者は「ImageMagick-7.0.10-37-Q16-x86-static.exe」をダウンロードしました。

ダウンロード後はインストーラーの指示通りに進めれば問題ないと思います。

本体のコーディング

変換処理をするためのWORDファイルをあらたに作成、次のようにマクロを作成します。「Microsoft Scripting Runtime」を利用しますので、「ツール」→「参照設定」より表示されるリストの中から該当の箇所にチェックを入れてください。

内部で使われているshell関数は呼び出した外部プログラム終了を待ちません。そのためデータ数が多いとフリーズを招きます。そのため、Archive Redo Blog:「[VB] Shell 関数で起動したプログラムの終了を待つ方法」を参考にさせていただき、コードを実装しました。ありがとうございました。

ファイル処理のループ中に、doeventsを実行していますが、これによりOSに制御を戻して×ボタンによる中断を可能にしています。他イベント蓄積によるエラーを回避するためのおまじない的にも使っています。

プログラム本体.docm

Option Explicit

'
' MSワードサムネイル作成
'

'image masic 終了待ちのための各種設定
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Public Const INFINITE As Long = &HFFFF


'ツール→参照設定→「Microsoft Scripting Runtime」にチェックを入れる

Dim mFs As FileSystemObject

Sub makeWordThumbnailAll()
  '通常処理
  Call makeWordThumbnailSub(False)
End Sub

Sub makeWordThumbnailSkipPdf()
  'PDFの作成だけは終えている場合はこちらを使ってください。
  Call makeWordThumbnailSub(True)
End Sub


Private Sub makeWordThumbnailSub(blnSkipPdf As Boolean)
  
  Dim strPdfDir As String 'ワーク(PDF)フォルダ
  Dim strExpDir As String '出力先フォルダ
  Dim strSrcDir As String '検索対象フォルダ
  Dim f As File
  Dim doc As Word.Document
  Dim intFn As Integer
  Dim i As Long
  Dim intCols As Integer
  Dim lngProcess As Long
  Dim hProcess As Variant
  
  'HTMLサムネイルの列数
  intCols = 6
  
  'ファイルシステムオブジェクトイニシャル
  Set mFs = New FileSystemObject
  
  strExpDir = ActiveDocument.Path & "\exp"
  strSrcDir = ActiveDocument.Path & "\src"
  strPdfDir = ActiveDocument.Path & "\pdf"
  
  If blnSkipPdf = False Then
  
    'ワークDIR作成
    If mFs.FolderExists(strSrcDir) = False Then
      MsgBox strSrcDir & "を作成して、Wordファイルをセットしてください", vbCritical, "確認"
      Exit Sub
    End If
    
    'PDFDIR作成
    If mFs.FolderExists(strPdfDir) = True Then
      If (MsgBox("ワークフォルダ" & strPdfDir & "がすでに存在します。既存のデータを削除してよろしいですか？", vbYesNo, "確認") = vbYes) Then
        mFs.DeleteFolder strPdfDir
      Else
        Exit Sub
      End If
    End If
    
    mFs.CreateFolder strPdfDir
  
  End If
  
  '出力DIR作成
  If mFs.FolderExists(strExpDir) = True Then
    If (MsgBox("出力フォルダ" & strExpDir & "がすでに存在します。既存のデータを削除してよろしいですか？", vbYesNo, "確認") = vbYes) Then
      mFs.DeleteFolder strExpDir
    Else
      Exit Sub
    End If
  End If
  mFs.CreateFolder strExpDir
  
  If blnSkipPdf = False Then
    'ワードファイルだったら一旦PDFに変換
    For Each f In mFs.GetFolder(strSrcDir).Files
      If isTarget(f.Path) Then
        Set doc = Documents.Open(f.Path)
        
         doc.ExportAsFixedFormat OutputFileName:=strPdfDir & "\" & f.Name & ".PDF", ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportFromTo, From:=1, to:=1, Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, BitmapMissingFonts:=True, UseISO19005_1:=False
        doc.Close False
        
        Set doc = Nothing
      End If
    Next
  End If
  
  'サムネイル表示用html作成
  intFn = FreeFile
  Open strExpDir & "\thumbnail.html" For Output As #intFn
  
  Print #intFn, "<html lang=""ja"">"
  Print #intFn, "<head>"
  Print #intFn, "<meta charset=""Shift_JIS"">"
  Print #intFn, "<meta name=""viewport"" content=""width=device-width, initial-scale=1.0"">"
  Print #intFn, "<title>サムネイル</title>"
  Print #intFn, "<style>"
  Print #intFn, "td { border: solid 1px #000000; border-collapse: collapse; width: " & CStr(CInt(1000 / intCols) / 10) & "% }"
  Print #intFn, ".image {"
  Print #intFn, "width: 100%;"
  Print #intFn, "height: auto;"
  Print #intFn, "}"
  Print #intFn, "</style>"

  Print #intFn, "</head>"
  Print #intFn, "<body>"
  Print #intFn, "<h3>" & Format(Now, "YYYY/MM/DD HH:NN:SS") & "作成</h3>"
  Print #intFn, "<table>"
  
  For Each f In mFs.GetFolder(strPdfDir).Files
    'PDFファイルをimage magickを使ってPNGに変換
    '-density に解像度をセットします200= 200dpi
    
    DoEvents
    
    '数が多いとフリーズするので1件ずつ待つ
    lngProcess = Shell("magick -density 150 """ & f.Path & """ """ & strExpDir & "\" & f.Name & ".PNG""")
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, lngProcess)
    If hProcess > 0 Then
        Call WaitForSingleObject(hProcess, INFINITE)
        CloseHandle hProcess
    End If
    
    '6列
    If i Mod intCols = 0 Then
       If i <> 0 Then
         Print #intFn, "</tr>"
       End If
       
       Print #intFn, "<tr>"
    End If
    
    'クリックで拡大
    Print #intFn, "<td onclick=""windowOpen('" & f.Name & ".PNG','" & Replace(f.Name, ".PDF", "") & "');"">"
    Print #intFn, Replace(f.Name, ".PDF", "") & "</br>"
    Print #intFn, "<img class=""image"" src=""" & f.Name & ".PNG""/>"
    Print #intFn, "</td>"
    
    i = i + 1
  Next
  
  If i <> 0 Then
    Do Until i Mod intCols = 0
       Print #intFn, "<td>&nbsp;</td>"
       i = i + 1
    Loop
    
    Print #intFn, "</tr>"
  End If

  Print #intFn, "</table>"
  Print #intFn, "<script>"
  Print #intFn, "function windowOpen(strUrl,strTitle) { "
  Print #intFn, "let w = window.open("""",""_blank"");"
  Print #intFn, "w.document.write(""<html><head></head><body><img src=""+strUrl+""></body></html>"");"
  Print #intFn, "}"
  Print #intFn, "</script>"
  Print #intFn, "</body>"
  Print #intFn, "</html>"
  
  Close #intFn
  
  'ファイルシステムオブジェクト解放
  Set mFs = Nothing
  
End Sub


Private Function isTarget(strPath As String) As Boolean
  '拡張子判断でdoc docxファイルだけを対象にします
  
  Dim strDir As String
  
  strDir = LCase(Dir(strPath))
  
  If Right(strDir, 4) = ".doc" Then
    isTarget = True
  ElseIf Right(strDir, 5) = ".docx" Then
    isTarget = True
  Else
    isTarget = False
  End If
  
End Function

マクロが正常終了すると、expフォルダの中にthumbnail.htmlファイルが作成されます。それをダブルクリックで表示させると、サムネイル画像になったWORDドキュメントの一覧が表示されます。一覧の状態からセル内をクリックすると該当のイメージが拡大します。

処理実行中は普通にWORDが立ち上がったりしますので、キーボードやマウス入力の影響を受けます。

expフォルダやpdfフォルダの初期化時に「書き込みできません。」というエラーが出る場合は、一度デバッグモードに移行し実行を再開させることで回避できます。それが面倒な場合は、expフォルダやpdfフォルダを事前に削除してから実行するようにしてください。

マクロを使ってPDFを作成する「doc.ExportAsFixedFormat」の個所は基本的にPDF出力する際のマクロを記録した値から、「OpenAfterExport:=False」にして作成したPDFがオープンされないように指定するのと、「Range:= wdExportFromTo」で1ページだけを対象にするよにしています。

今回は各ファイルの先頭の1ページだけを対象にしましたが、Image Magickの方は複数ページにも対応しているので、HTML側を工夫すれば複数ページのサムネイル化もできると思います。

トップ画像を作成するにあたり「ビジネステンプレート」の「送付状ワードテンプレート」を使用させていただきました。ありがとうございました。

投稿:2021/12/11 - 更新:

MS-WORDファイルのプレビューを画像化

構造

Image Magick

本体のコーディング

close close

投稿:2021/12/11 - 更新:　