VBSでExcel、Word、PowerPointを一括でPDFに変換してみる
おはようございます。
ExcelやWordを使って資料を作った後、
大体はPDFに変換して誰かに送付したり、社内でレビューをしたりしますよね。
ビジネスシーンでは最早当たり前のようにやられていることかと思います。
まあ、あまりないシーンかもしれませんが、
沢山のドキュメントを一括で変換したいって時に使えるバッチ（VBScript）を作りました。
スポンサーリンク
目次
そもそも何故PDFに変換するのか
送受信者でレイアウトに相違が起きにくい
Excel、Wordであれば、バージョンや各自の設定によって見え方が異なってしまう可能性がありますが、PDFはどんな環境でも同じレイアウトで閲覧することができます。
Officeが入っていなくても閲覧可能
今の時代、あんまりないのかもしれませんが、Excel、Wordの場合はそれぞれのソフトウェアがインストールされていないと閲覧ができません。
サイズが圧縮される
一般的に、PDFに変換するとサイズが圧縮されるため、メールなんかで送受信する際には双方にメリットがあります。
加工できない
重要な書類などは、誰かに加工されてしまうと困る場合があります。
ExcelやWordなんかにもパスワードでロックする機能がありますが、PDFであれば特に何もする必要なく、基本的には加工できません。（特別なソフトなんかでは出来る場合がありますが）
VBScript
2018年10月10日 追記
次の方法でPDF化できるようにしました。
- ブック全体
- アクティブシートのみ（最後に保存した際に、アクティブだったシート）
- ページ指定（From ～ To）
また、出力後に元ファイルを削除するかどうかのフラグを持たせ、元ファイルの削除に対応しました。
※バックアップなど、自己責任でお願いします。
2019年03月22日 追記
ひしもち様のご指摘で、Office 2013以前の場合に保存ダイアログが表示されてしまうケースに対応しました。
（ドキュメントを閉じる前後で、App.DisplayAlertsの値を操作）
2019年09月06日 追記
びば様の要望で、PowerPointに対応しました。
2019年10月09日 追記
全体的に修正。
変換したPDFを別のフォルダに出力するかどうかを「copyFlg」で制御するようにしました。
追加部分
変数の宣言を追加
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | DimSheet 'アクティブシートのみとするかどうかのフラグ（0：オフ／1：オン） DimActiveSheetFlg ActiveSheetFlg=1 'ページ指定 'From が 0 であれば指定しない DimPageFrom DimPageTo PageFrom=0 PageTo=0 '変換元ファイルを削除するかどうか DimDeleteFlg DeleteFlg=0 |
出力処理
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | ifActiveSheetFlg=1Then ' アクティブシート指定 SetSheet=Book.ActiveSheet IfErr.Number<>0Then ' 終了( 開放 ) ExcelApp.Quit() Wscript.Echo Err.Description&vbCrLf&strCurrentPath ' スクリプト終了 Wscript.Quit() EndIf on errorgoto0 CallSheet.ExportAsFixedFormat(0,tmpFilePath) Else ifPageFrom=0Then ' ブック全体 CallBook.ExportAsFixedFormat(0,tmpFilePath,0) Else ' ページ指定 CallBook.ExportAsFixedFormat(0,tmpFilePath,0,False,False,PageFrom,PageTo,False) Endif Endif |
元ファイル削除
1 2 3 4 5 6 7 8 9 10 11 12 | ' 変換したファイルを移動 IfFso.GetExtensionName(objItem.Name)="xls"OrFso.GetExtensionName(objItem.Name)="xlsx"OrFso.GetExtensionName(objItem.Name)="doc"OrFso.GetExtensionName(objItem.Name)="docx"Then ' PDFのみコピー Fso.CopyFile tmpFilePath,crtFolderPath&"\",true ' コピー後に削除 Fso.DeleteFile tmpFilePath ifDeleteFlg=1Then ' 元ファイルを削除 Fso.DeleteFile objItem.Path EndIf EndIf |
全体
下記の内容をテキストファイルにコピペして、「convertPdf.vbs」という名前で保存します。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 | OptionExplicit '********************************************************************************** ' ■概要 ' 実行ファイルと同じ階層以下の ' Excel、Word ファイルを PDF に変換して指定したフォルダに出力します。 ' ' ※ Office 2007 以上、プリンタが使用できる環境でのみ動作します。 '********************************************************************************** '============================================================== ' 変数の宣言、初期化 '============================================================== 'フォルダ操作用 DimFso DimobjApl DimobjFolder DimobjFolderTo DimobjFolderItems DimstrCurrentPath Dimobj DimcrtFolderPath DimtmpFilePath 'Excel用 DimExcelApp DimWordApp DimPowerPointApp DimDoc DimBook DimSheet DimPresentations 'コピーするかどうか（0：しない／1：する） DimcopyFlg copyFlg=0 'コピー先 DimcopyTo 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)=falseThen Fso.CreateFolder(crtFolderPath) EndIf 'フォルダであれば再起処理を実施 SetobjFolderItemsB=objItem.GetFolder CallprcFolder(objFolderItemsB) 'パスを戻る crtFolderPath=tmpFolderPath Else flg=0 ' 親ディレクトリがなければ作成 If copyFlg=1Then If Fso.FolderExists(crtFolderPath)=falseThen Fso.CreateFolder(crtFolderPath) EndIf EndIf SelectCase 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" SetDoc=WordApp.Documents.Open(objItem.Path,true) If Err.Number<>0Then ' 終了( 開放 ) WordApp.Quit() Wscript.Echo Err.Description&vbCrLf&strCurrentPath ' スクリプト終了 Wscript.Quit() EndIf on errorgoto0 CallWordApp.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=1Then ' 元ファイルを削除 Fso.DeleteFile objItem.Path EndIf EndIf EndIf Next ' 終了( 開放 ) SetobjItem=Nothing SetobjFolderItemsB=Nothing EndSub |
実行してみる
Excelフォルダ―にはExcelファイルを2種類、同じ階層にはWordファイルを2種類配置しました。
この状態で、ConverPdf.vbsを実行。
変換が完了するとメッセージが表示されます。
VBScript内で指定した出力先にPDFが出力されます。
PDFを表示してみると、ちゃんと内容が表示されることが確認できました。
まとめ
例えば、タスクスケジューラなんかに仕込んで
決まったフォルダにドキュメントを入れておけば自動で変換してくれるなんてこともできそうですね。
ではでは。