Office関連

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関連

    右クリックから図形の配置 for Office 2013

    HPの掲示板に"右クリックから「配置」を実行できないか?"という質問が…

  2. Office関連

    「Excel VBAでIEを思いのままに操作できるプログラミング術」の見本誌をいただきました。

    「VBAアクションゲーム?Excel(エクセル)で動かそう!」で有名な…

  3. Office関連

    Google翻訳で文字列を翻訳するマクロ

    ※ 2016/2 時点では下記の方法はもう使用できなくなっています。V…

  4. アイコン一覧

    Office 2013 アイコン一覧(X,Y,Z)

    ・Office 2013 アイコン一覧 NUM…

  5. Office アドイン

    Office 用アプリの開発資料(日本語)が公開されました。

    Office 用アプリの開発資料(日本語)が公開されました。・…

  6. Office関連

    スライドショーをループ再生設定するPowerPointマクロ

    PowerPointでスライドショーを作成するとき、投影した後流しっぱ…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP