Excel

PDFを他のファイル形式に変換するVBAマクロ

PDF 変換 Word VBA」といったキーワード検索でのアクセスがありました。
マクロでPDFファイルをWordファイルに変換する方法を探している方だろうと思います。

Acrobat JavaScriptのDocオブジェクトには別の形式でファイルを保存するためのsaveAsメソッドが用意されており、そのメソッドをGetJSObject経由で呼び出すことで、VBAマクロからでも処理を実行することができます。

Option Explicit

Private Enum Conv
  TypeDoc = 0
  TypeDocx = 1
  TypeEps = 2
  TypeHtml = 3
  TypeJpeg = 4
  TypeJpf = 5
  TypePdfA = 6
  TypePdfE = 7
  TypePdfX = 8
  TypePng = 9
  TypePs = 10
  TypeRft = 11
  TypeTiff = 12
  TypeTxtA = 13
  TypeTxtP = 14
  TypeXlsx = 15
  TypeSpreadsheet = 16
  TypeXml = 17
End Enum

Public Sub Sample()
  ConvertPDF "C:\Test\PDF\Sample.pdf", TypeDocx
End Sub

Private Sub ConvertPDF(ByVal TargetFilePath As String, _
                       ByVal TargetConvType As Conv)
'PDFを他のファイル形式に変換
  Dim jso As Object
  Dim convid As String
  Dim ext As String
  Dim fp As String, fn As String
  
  'フォルダパスとファイル名取得
  With CreateObject("Scripting.FileSystemObject")
    fp = AddPathSeparator(.GetParentFolderName(TargetFilePath))
    fn = .GetBaseName(TargetFilePath)
  End With
  
  convid = GetConvID(TargetConvType)
  ext = GetExtension(TargetConvType)
  With CreateObject("AcroExch.PDDoc")
    If .Open(TargetFilePath) = True Then
      Set jso = .GetJSObject
      CallByName jso, "saveAs", VbMethod, _
                 fp & fn & "." & ext, convid
      .Close
    End If
  End With
End Sub

Private Function GetConvID(ByVal ConvType As Conv) As String
'cConvID取得
  Dim v As Variant
  
  v = Array("com.adobe.acrobat.doc", "com.adobe.acrobat.docx", "com.adobe.acrobat.eps", _
            "com.adobe.acrobat.html", "com.adobe.acrobat.jpeg", "com.adobe.acrobat.jp2k", _
            "com.callas.preflight.pdfa", "com.callas.preflight.pdfe", "com.callas.preflight.pdfx", _
            "com.adobe.acrobat.png", "com.adobe.acrobat.ps", "com.adobe.acrobat.rtf", _
            "com.adobe.acrobat.tiff", "com.adobe.acrobat.accesstext", "com.adobe.acrobat.plain-text", _
            "com.adobe.acrobat.xlsx", "com.adobe.acrobat.spreadsheet", "com.adobe.acrobat.xml-1-00")
  GetConvID = v(ConvType)
End Function

Private Function GetExtension(ByVal ConvType As Conv) As String
'拡張子取得
  Dim v As Variant
  
  v = Array("doc", "docx", "eps", "html", "jpeg", "jpf", "pdf", "pdf", "pdf", "png", _
            "ps", "rft", "tiff", "txt", "txt", "xlsx", "xml", "xml")
  GetExtension = v(ConvType)
End Function

Private Function AddPathSeparator(ByVal s As String)
  If Right(s, 1) <> ChrW(92) Then s = s & ChrW(92)
  AddPathSeparator = s
End Function

saveAsメソッドを実行する際、変換形式を文字列(cConvID)として指定する必要がありますが、上記コードでは形式を指定しやすいよう、列挙型を定義して使用しています。

関連記事

  1. アイコン一覧

    Office 2013 アイコン一覧(G)

    ・Office 2013 アイコン一覧 NUM…

  2. Office関連

    [Office 2016]コマンド検索即実行、便利な「Tell Me」機能

    ※ 下記情報はOffice 2016 Preview版を元にしています…

  3. Excel

    VBAでインターネット上のファイルをダウンロードする方法をまとめてみました。

    「VBA ファイル ダウンロード」といったキーワード検索でのアクセスが…

  4. Office アドイン

    [Office用アプリ]マニフェストファイルをSharePointに配置する。

    今更になりますが、今回はマニフェストファイルをSharePoint上に…

  5. Office関連

    Word 2013のアクセス キー一覧[PDF]

    前回の記事でWord 2013のアクセス キーをまとめたものを公開しま…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP