Word、Excel、PowerPoint 2007形式から旧形式へ
うちの職場、Office2007と、2007より古いOfficeとが混在しており、2007形式のファイルを旧形式で保存しなおすなんてことをよくやる。いちいち操作するのが面倒だったので、保存しなおす操作を自動でやるスクリプトを書いてみた。
自分は、Windows XP SP2(32bit版)、Office 2007 Professionalがインストールされている環境で使っている。
"ConvertToOldFormat.vbs"などといった名前で保存する。拡張子が".vbs"であれば名前は何でも良い。
"ConvertToOldFormat.vbs"に、"hoge.docx"など、2007形式のファイルをドロップすると、古い形式で保存されたファイルを作る。
'"ConvertToOldFormat.vbs" '旧形式を表す定数。 Const wdFormatDocument = 0 Const xlExcel8 = 56 Const ppSaveAsPresentation = 1 Dim fso Dim word Dim excel Dim powerPoint Dim matches Set word = Nothing Set excel = Nothing Set powerPoint = Nothing Sub launchWord If word Is Nothing Then Set word = CreateObject("Word.Application") 'word.Visible = True End If End Sub Sub launchExcel If excel Is Nothing Then Set excel = CreateObject("Excel.Application") 'excel.Visible = True End If End Sub Sub launchPowerPoint If powerPoint Is Nothing Then Set powerPoint = CreateObject("PowerPoint.Application") 'powerPoint.Visible = True End If End Sub Sub quitWord If Not word Is Nothing Then word.Quit End If End Sub Sub quitExcel If Not excel Is Nothing Then excel.Quit End If End Sub Sub quitPowerPoint If Not powerPoint Is Nothing Then powerPoint.Quit End If End Sub Set fso = CreateObject("Scripting.FileSystemObject") Set wordRgx = New RegExp wordRgx.Pattern = "^(.+)\.docx$" wordRgx.IgnoreCase = True Set excelRgx = New RegExp excelRgx.Pattern = "^(.+)\.xlsx$" excelRgx.IgnoreCase = True Set powerPointRgx = New RegExp powerPointRgx.Pattern = "^(.+)\.pptx$" powerPointRgx.IgnoreCase = True Set args = WScript.Arguments If (args.Count > 0) Then For i = 0 To (args.Count - 1) filePath = args(i) '---------------------------------------------------------------- 'Word Set matches = wordRgx.Execute(filePath) If (matches.Count > 0) Then newFilePath = matches(0).SubMatches(0) & ".doc" launchWord Set wdDoc = word.Documents.Open(filePath) wdDoc.SaveAs newFilePath, wdFormatDocument wdDoc.Close End If '---------------------------------------------------------------- 'Excel Set matches = excelRgx.Execute(filePath) If (matches.Count > 0) Then newFilePath = matches(0).SubMatches(0) & ".xls" launchExcel Set xlDoc = excel.Workbooks.Open(filePath) xlDoc.SaveAs newFilePath, xlExcel8 xlDoc.Close End If '---------------------------------------------------------------- 'PowerPoint Set matches = powerPointRgx.Execute(filePath) If (matches.Count > 0) Then newFilePath = matches(0).SubMatches(0) & ".ppt" launchPowerPoint Set ppDoc = powerPoint.Presentations.Open(filePath, True) ppDoc.SaveAs newFilePath, ppSaveAsPresentation ppDoc.Close End If Next End If MsgBox "終了しました。" '後始末。 quitWord quitExcel quitPowerPoint