VBSでExcel、Word、PowerPointを一括でPDFに変換してみる

2017年12月7日VBScript,開発

おはようございます。

ExcelやWordを使って資料を作った後、
大体はPDFに変換して誰かに送付したり、社内でレビューをしたりしますよね。
ビジネスシーンでは最早当たり前のようにやられていることかと思います。

まあ、あまりないシーンかもしれませんが、
沢山のドキュメントを一括で変換したいって時に使えるバッチ（VBScript）を作りました。

スポンサーリンク

そもそも何故PDFに変換するのか

送受信者でレイアウトに相違が起きにくい

Excel、Wordであれば、バージョンや各自の設定によって見え方が異なってしまう可能性がありますが、PDFはどんな環境でも同じレイアウトで閲覧することができます。

Officeが入っていなくても閲覧可能

今の時代、あんまりないのかもしれませんが、Excel、Wordの場合はそれぞれのソフトウェアがインストールされていないと閲覧ができません。

サイズが圧縮される

一般的に、PDFに変換するとサイズが圧縮されるため、メールなんかで送受信する際には双方にメリットがあります。

加工できない

重要な書類などは、誰かに加工されてしまうと困る場合があります。
ExcelやWordなんかにもパスワードでロックする機能がありますが、PDFであれば特に何もする必要なく、基本的には加工できません。（特別なソフトなんかでは出来る場合がありますが）

VBScript

2018年10月10日　追記

次の方法でPDF化できるようにしました。

  1. ブック全体
  2. アクティブシートのみ（最後に保存した際に、アクティブだったシート）
  3. ページ指定（From ～ To）

また、出力後に元ファイルを削除するかどうかのフラグを持たせ、元ファイルの削除に対応しました。
※バックアップなど、自己責任でお願いします。

2019年03月22日　追記

ひしもち様のご指摘で、Office 2013以前の場合に保存ダイアログが表示されてしまうケースに対応しました。
（ドキュメントを閉じる前後で、App.DisplayAlertsの値を操作）

2019年09月06日　追記

びば様の要望で、PowerPointに対応しました。

2019年10月09日　追記

全体的に修正。
変換したPDFを別のフォルダに出力するかどうかを「copyFlg」で制御するようにしました。

追加部分

変数の宣言を追加

Dim Sheet

'アクティブシートのみとするかどうかのフラグ（0：オフ／1：オン）
Dim ActiveSheetFlg
ActiveSheetFlg = 1

'ページ指定
'From が 0 であれば指定しない
Dim PageFrom
Dim PageTo
PageFrom = 0
PageTo = 0

'変換元ファイルを削除するかどうか
Dim DeleteFlg
DeleteFlg = 0

出力処理

	if ActiveSheetFlg = 1 Then
		' アクティブシート指定
		Set Sheet = Book.ActiveSheet
		If Err.Number <> 0 Then
				' 終了( 開放 )
				ExcelApp.Quit()
				Wscript.Echo Err.Description & vbCrLf & strCurrentPath
				' スクリプト終了
				Wscript.Quit()
		End If
		on error goto 0
		Call Sheet.ExportAsFixedFormat(0, tmpFilePath)
	Else
		if PageFrom = 0 Then
			' ブック全体
			Call Book.ExportAsFixedFormat(0, tmpFilePath, 0)
		Else
			' ページ指定
			Call Book.ExportAsFixedFormat(0, tmpFilePath, 0, False, False, PageFrom, PageTo, False)
		End if
	End if

元ファイル削除

	' 変換したファイルを移動
	If Fso.GetExtensionName(objItem.Name) = "xls" Or Fso.GetExtensionName(objItem.Name) = "xlsx" Or Fso.GetExtensionName(objItem.Name) = "doc" Or Fso.GetExtensionName(objItem.Name) = "docx" Then
			' PDFのみコピー
			Fso.CopyFile tmpFilePath, crtFolderPath & "\", true
			' コピー後に削除
			Fso.DeleteFile tmpFilePath

			if DeleteFlg = 1 Then
				' 元ファイルを削除
				Fso.DeleteFile objItem.Path
			End If
	End If

 

全体

下記の内容をテキストファイルにコピペして、「convertPdf.vbs」という名前で保存します。

Option Explicit
'**********************************************************************************
' ■概要
'   実行ファイルと同じ階層以下の
'   Excel、Word ファイルを PDF に変換して指定したフォルダに出力します。
'
'   ※ Office 2007 以上、プリンタが使用できる環境でのみ動作します。
'**********************************************************************************

'==============================================================
' 変数の宣言、初期化
'==============================================================

'フォルダ操作用
Dim Fso
Dim objApl
Dim objFolder
Dim objFolderTo
Dim objFolderItems
Dim strCurrentPath
Dim obj
Dim crtFolderPath
Dim tmpFilePath

'Excel用
Dim ExcelApp
Dim WordApp
Dim PowerPointApp
Dim Doc
Dim Book
Dim Sheet
Dim Presentations

'コピーするかどうか（0：しない／1：する）
Dim copyFlg
copyFlg = 0

'コピー先
Dim copyTo
copyTo = "C:\work\temp\"

'アクティブシートのみとするかどうかのフラグ（0：オフ／1：オン）
Dim ActiveSheetFlg
ActiveSheetFlg = 1

'ページ指定
'From が 0 であれば指定しない
Dim PageFrom
Dim PageTo
PageFrom = 0
PageTo = 0

'変換元ファイルを削除するかどうか
Dim DeleteFlg
DeleteFlg = 0

'==============================================================
' 処理開始
'==============================================================

'１．ファイルオブジェクトを作成
Set Fso = CreateObject( "Scripting.FileSystemObject" )

'２．実行ファイルが格納されているパスを取得
strCurrentPath = WScript.ScriptFullName
Set obj = Fso.GetFile( strCurrentPath )
Set obj = obj.ParentFolder
strCurrentPath = obj.Path

'３．Excel, Word アプリケーションオブジェクトを作成します。
Set ExcelApp = CreateObject("Excel.Application")
Set WordApp = CreateObject("Word.Application")
Set PowerPointApp = CreateObject("PowerPoint.Application")

'４．シェルアプリケーションオブジェクトを作成します
Set objApl = WScript.CreateObject("Shell.Application")

'５．実行ファイルと同じ階層のフォルダオブジェクトを作成します
Set objFolder = objApl.NameSpace(strCurrentPath)

'６．実行ファイルの親フォルダがコピー先になければ作成する
If copyFlg = 1 Then
	crtFolderPath = copyTo & Fso.GetBaseName(strCurrentPath)
	If Fso.FolderExists(crtFolderPath) = false Then
			Fso.CreateFolder(crtFolderPath)
	End If
End If

'７．フォルダオブジェクトから格納されているファイル、フォルダを取得します。
Set objFolderItems = objFolder.Items()

'８．ファイル、フォルダ単位の処理
Call prcFolder (objFolder)

'９．終了処理
ExcelApp.Quit()
WordApp.Quit()
PowerPointApp.Quit()
Set ExcelApp = Nothing
Set WordApp = Nothing
Set PowerPointApp = Nothing
Set objFolderItems = Nothing
Set objFolder = Nothing
Set objApl = Nothing

If copyFlg = 1 Then
	Wscript.Echo crtFolderPath & " に変換したPDFを出力しました。"
Else
	Wscript.Echo "PDFの変換が完了しました。"
End If

'------------------------------------------------------------------------------------------
' ■サブプログラム
'   フォルダ内に含まれるファイルやフォルダを検索し、
'   Excel、Word ファイルを PDF ファイルに変換する。
'------------------------------------------------------------------------------------------
Sub prcFolder(objFolder)

		Dim tmpFolderPath
		Dim tmpFolderItems
		Dim crtFolderPathB
		Dim objFolderItemsB
		Dim objItem
		Dim i
		Dim flg
		Set tmpFolderItems = objFolder.Items()

		' フォルダ内アイテムの走査
		For i=0 To tmpFolderItems.Count-1

				'ファイルおよびフォルダオブジェクトを取得
				Set objItem = tmpFolderItems.Item(i)
				'Wscript.Echo "パス：" & objItem.Name

				'ファイル、フォルダの判定
				If objItem.IsFolder Then

						'パスを退避
						tmpFolderPath = crtFolderPath

						'処理中のディレクトリをパスに含める
						crtFolderPath = crtFolderPath & "\" & objItem.Name
						' 親ディレクトリがなければ作成
						If Fso.FolderExists(crtFolderPath) = false Then
								Fso.CreateFolder(crtFolderPath)
						End If

						'フォルダであれば再起処理を実施
						Set objFolderItemsB = objItem.GetFolder
						Call prcFolder (objFolderItemsB)

						'パスを戻る
						crtFolderPath = tmpFolderPath

				Else

						flg = 0
						
						' 親ディレクトリがなければ作成
						If copyFlg = 1 Then
							If Fso.FolderExists(crtFolderPath) = false Then
									Fso.CreateFolder(crtFolderPath)
							End If
						End If
						
						Select Case LCase(fso.GetExtensionName(objItem.Name))

							' Excelの場合
							Case "xls", "xlsx"

								' 出力パス
								tmpFilePath = Fso.GetParentFolderName(objItem.Path) & "\" & Fso.GetBaseName(objItem.Name) & ".pdf"

								Set Book = ExcelApp.Workbooks.Open( objItem.Path )
								If Err.Number <> 0 Then
										' 終了( 開放 )
										ExcelApp.Quit()
										Wscript.Echo Err.Description & vbCrLf & strCurrentPath
										' スクリプト終了
										Wscript.Quit()
								End If
								on error goto 0

								if ActiveSheetFlg = 1 Then
									' アクティブシート指定
									Set Sheet = Book.ActiveSheet
									If Err.Number <> 0 Then
											' 終了( 開放 )
											ExcelApp.Quit()
											Wscript.Echo Err.Description & vbCrLf & strCurrentPath
											' スクリプト終了
											Wscript.Quit()
									End If
									on error goto 0
									Call Sheet.ExportAsFixedFormat(0, tmpFilePath)
								Else
									if PageFrom = 0 Then
										' ブック全体
										Call Book.ExportAsFixedFormat(0, tmpFilePath, 0)
									Else
										' ページ指定
										Call Book.ExportAsFixedFormat(0, tmpFilePath, 0, False, False, PageFrom, PageTo, False)
									End if
								End if

								' 終了( 開放 )
								ExcelApp.DisplayAlerts = False
								Book.Close
								ExcelApp.DisplayAlerts = True
								flg = 1

							' Wordの場合
							Case "doc", "docx"

								' 出力パス
								tmpFilePath = Fso.GetParentFolderName(objItem.Path) & "\" & Fso.GetBaseName(objItem.Name) & ".pdf"

								Set Doc = WordApp.Documents.Open( objItem.Path, true)

								If Err.Number <> 0 Then
										' 終了( 開放 )
										WordApp.Quit()
										Wscript.Echo Err.Description & vbCrLf & strCurrentPath
										' スクリプト終了
										Wscript.Quit()
								End If
								on error goto 0

								Call WordApp.ActiveDocument.ExportAsFixedFormat( tmpFilePath,17,False)

								' 終了( 開放 )
								WordApp.DisplayAlerts = False
								Doc.Close
								WordApp.DisplayAlerts = True
								flg = 1


							' PowerPointの場合
							Case "ppt", "pptx"

								' 出力パス
								tmpFilePath = Fso.GetParentFolderName(objItem.Path) & "\" & Fso.GetBaseName(objItem.Name) & ".pdf"

								Set Presentations = PowerPointApp.Presentations.Open( objItem.Path, True, False, False)

								If Err.Number <> 0 Then
										' 終了( 開放 )
										WordApp.Quit()
										Wscript.Echo Err.Description & vbCrLf & strCurrentPath
										' スクリプト終了
										Wscript.Quit()
								End If
								on error goto 0

								Call Presentations.SaveAs( tmpFilePath, 32, False)

								' 終了( 開放 )
								PowerPointApp.DisplayAlerts = False
								Presentations.Close
								PowerPointApp.DisplayAlerts = True
								flg = 1

						End Select
						
						' 変換したファイルを移動
						
						If copyFlg = 1 And flg = 1 Then
							' PDFのみコピー
							Fso.CopyFile tmpFilePath, crtFolderPath & "\", true
							' コピー後に削除
							Fso.DeleteFile tmpFilePath

							if DeleteFlg = 1 Then
								' 元ファイルを削除
								Fso.DeleteFile objItem.Path
							End If
						End If

				End If

		Next

		' 終了( 開放 )
		Set objItem = Nothing
		Set objFolderItemsB = Nothing

End Sub

 

実行してみる

フォルダ内容

Excelフォルダ―にはExcelファイルを2種類、同じ階層にはWordファイルを2種類配置しました。

この状態で、ConverPdf.vbsを実行。

完了メッセージ

変換が完了するとメッセージが表示されます。

変換後のフォルダ内容

VBScript内で指定した出力先にPDFが出力されます。

PDFファイル

PDFを表示してみると、ちゃんと内容が表示されることが確認できました。

まとめ

例えば、タスクスケジューラなんかに仕込んで
決まったフォルダにドキュメントを入れておけば自動で変換してくれるなんてこともできそうですね。

ではでは。

スポンサーリンク


関連するコンテンツ

2017年12月7日VBScript,開発Batch,vbs,VBScript,バッチ,プログラミング

Posted by doradora