Excel/Word/PowerPointファイルを一括PDF変換

Excel/Word/PowerPointファイルを一括でPDFに変換するスクリプトのメモ。

Acrobatとかフリーソフトとか使えればいいんですけどね。

使えない場合にExcel/Word/PowerPointさえあれば一括でPDFに変換できるVBSスクリプト。

対象ファイルをVBSスクリプトファイルにドロップ。

複数ファイルのドロップも可。

進捗をIEを使って表示する。

ファイル名は任意。

■VBSスクリプトファイル

Option Explicit
Call Main()

Sub Main()
  Const XLS2PDF = 0
  Const DOC2PDF = 17
  Const PPT2PDF = 32
  Dim myFname, myOffice, myArgNum, i, myIE

  myArgNum = Wscript.Arguments.Count

  If myArgNum = 0 Then
    Wscript.Echo "変換したいファイルを本スクリプトにドロップしてください。"
    Exit Sub
  End If

  '進捗表示用のIEオブジェクトを生成
  Set myIE = WScript.CreateObject("InternetExplorer.Application")
  myIE.Navigate "about:blank"
  While myIE.busy: Wend
  While myIE.Document.readyState <> "complete": DoEvents : Wend
  myIE.AddressBar = False
  myIE.ToolBar = False
  myIE.StatusBar = False
  myIE.Height = 150
  myIE.Width = 500
  myIE.Visible = True

  i = 1
  For Each myFname In Wscript.Arguments
    Set myOffice = GetObject(myFname)
    myIE.Document.body.innerHTML = "【進捗】" & i & " / " & myArgNum & "

【処理ファイル】" & myOffice.Name & ""
    If myOffice.Application = "Microsoft PowerPoint" Then
      myOffice.SaveAs GetFNameFromFStr(myOffice.FullName)+".pdf", PPT2PDF
    Elseif myOffice.Application = "Microsoft Excel" Then
      myOffice.ExportAsFixedFormat XLS2PDF , GetFNameFromFStr(myOffice.FullName)+".pdf"
    Elseif myOffice.Application = "Microsoft Word" Then
      myOffice.SaveAs GetFNameFromFStr(myOffice.FullName)+".pdf", DOC2PDF
    End If
    myOffice.Close
    i = i + 1
  Next
  myIE.Quit
  Wscript.Echo "完了"
End Sub

Function GetFNameFromFStr(sFileName )
Dim sFileStr' As String
Dim lFindPoint 'As Long
Dim lStrLen' As Long
    lFindPoint = InStrRev(sFileName, ".")
    sFileStr = Left(sFileName, lFindPoint - 1)
    GetFNameFromFStr = sFileStr
End Function