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

ホーム
Office関連, Excel, Word, PowerPoint, Acrobat
PDFを他のファイル形式に変換するVBAマクロ

2016.09.26

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