xlsxやdocxといった新しい形式のOffice文書をスクリプトファイルにドラッグ&ドロップすると、xlsやdocといった旧バージョンのファイル形式に変換して元ファイルと同じフォルダーに出力するVBScriptです。
Option Explicit Dim Fso Dim Args Dim OutputFilePath Dim i Const wdFormatDocument = 0 Const wdDoNotSaveChanges = 0 Const xlNormal = -4143 Const ppSaveAsPresentation = 1 Set Fso = CreateObject("Scripting.FileSystemObject") Set Args = WScript.Arguments If Args.Count < 1 Then MsgBox "旧バージョンのファイル形式に変換したいOffice文書を当スクリプトファイルにドラッグ&ドロップしてください。" WScript.Quit End If 'ドロップされたファイルを処理(複数ファイル対応) On Error Resume Next For i = 0 To Args.Count - 1 '拡張子によって処理分岐 Select Case LCase(Fso.GetExtensionName(Args(i))) 'Wordファイル処理 Case "docx", "docm" OutputFilePath = Fso.GetParentFolderName(Args(i)) & ChrW(92) & Fso.GetBaseName(Args(i)) & ".doc" With CreateObject("Word.Application") .Visible = True .DisplayAlerts = False With .Documents.Open(Args(i)) .SaveAs OutputFilePath, wdFormatDocument .Close wdDoNotSaveChanges End With .DisplayAlerts = True .Quit End With 'Excelファイル処理 Case "xlsx", "xlsm" OutputFilePath = Fso.GetParentFolderName(Args(i)) & ChrW(92) & Fso.GetBaseName(Args(i)) & ".xls" With CreateObject("Excel.Application") .Visible = True .DisplayAlerts = False With .Workbooks.Open(Args(i)) .SaveAs OutputFilePath, xlNormal .Close False End With .DisplayAlerts = True .Quit End With 'PowerPointファイル処理 Case "pptx", "pptm" OutputFilePath = Fso.GetParentFolderName(Args(i)) & ChrW(92) & Fso.GetBaseName(Args(i)) & ".ppt" With CreateObject("PowerPoint.Application") .Visible = True .DisplayAlerts = False With .Presentations.Open(Args(i)) .SaveAs OutputFilePath, ppSaveAsPresentation .Close End With .DisplayAlerts = True .Quit End With End Select WScript.Sleep 500 '処理待ち Next On Error GoTo 0 MsgBox "処理が終了しました。"
5年くらい前に書いたものが出てきたので、忘れないうちにメモしておきます。
■ 関連記事
・古い形式のWordテンプレートを新しい形式に一括変換するVBScript
//www.ka-net.org/blog/?p=3427
・ドラッグ&ドロップでExcelファイルをアドイン形式(xlam)に一括変換するVBScript
//www.ka-net.org/blog/?p=5264
この記事へのコメントはありません。