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















この記事へのコメントはありません。