【SendTo】ファイルを新しいプロセスで開く＋読み取り専用で開く(Excel/Word)

これは何？

Excel/Wordのファイルをプロセスを分けて開くためのスクリプト。ついでに読み取り専用で開くオプション機能付き。
SendToフォルダに置いて使う。(%APPDATA%\Microsoft\Windows\SendTo)

発端は複数のExcelファイルを別ウィンドウで開きたかった

Excelは2010までMDI¹だったので、ファイル毎にウィンドウを分けて表示したいときに使っていた。

Excel2013以降はSDI²になったが、同じ名前のファイルを同時に開くにはプロセスを分ける必要があった。が、新しいExcelプロセスを起動するのが面倒なことになっているので³、その面倒臭さを解消するために使っていた。

Excel2016は2013の面倒臭さに加えて挙動が不安定で、複数ファイルの編集中にExcelがお亡くなりになることが稀によくある。そのような「未保存のファイル終了のお知らせ」を回避するためにもまだ役に立っている。

Windows10の仮想デスクトップでも活躍する

Windows10の仮想デスクトップ利用中にExcelファイルを開くと、既にExcelを起動していた場合はそのウィンドウがあるデスクトップに勝手に切り替わってしまう。このスクリプトでファイルを開けば、勝手に切り替わることもなくなる。

コード

新しいプロセスで開く.vbs

Option Explicit

Dim FSO:	Set FSO = CreateObject("Scripting.FileSystemObject")
Dim WSH:	Set WSH = CreateObject("WScript.Shell")

Main

WScript.Quit



'***********************************************************
' メイン関数
'***********************************************************
Sub Main()
	Dim vbReturn
	Dim flgReadOnly
	Dim strArgument

	' 読み取り専用の確認
	vbReturn = MsgBox("読み取り専用で開きますか？", vbYesNoCancel)
	If vbReturn = vbYes Then
		flgReadOnly = True
	ElseIf vbReturn = vbNo Then
		flgReadOnly = False
	Else
		Exit Sub
	End If

	' コマンドラインのファイルを順に処理する
	For Each strArgument In WScript.Arguments.Unnamed
		' ファイルを新しいウィンドウで開く
		Call OpenFileNewWindow(strArgument, flgReadOnly)
	Next

End Sub


'***********************************************************
' ファイルを新しいウィンドウで開く
'***********************************************************
Sub OpenFileNewWindow(strFile, flgReadOnly)
	Dim wshShortcut

	Select Case FSO.GetExtensionName(strFile)
	'-----------------------------------------------------------
	' Excelで開く拡張子
	'-----------------------------------------------------------
	Case "xls"
		Call OpenFileNewExcel(strFile, flgReadOnly)
	Case "xlsx"
		Call OpenFileNewExcel(strFile, flgReadOnly)
	Case "xlsm"
		Call OpenFileNewExcel(strFile, flgReadOnly)
	Case "csv"
		Call OpenFileNewExcel(strFile, flgReadOnly)

	'-----------------------------------------------------------
	' Wordで開く拡張子
	'-----------------------------------------------------------
	Case "doc"
		Call OpenFileNewWord(strFile, flgReadOnly)
	Case "docx"
		Call OpenFileNewWord(strFile, flgReadOnly)
	Case "docm"
		Call OpenFileNewWord(strFile, flgReadOnly)

	'-----------------------------------------------------------
	' PowerPointで開く拡張子
	'-----------------------------------------------------------
	Case "ppt"
		Call OpenFileNewPowerpoint(strFile, flgReadOnly)
	Case "pptx"
		Call OpenFileNewPowerpoint(strFile, flgReadOnly)
	Case "pptm"
		Call OpenFileNewPowerpoint(strFile, flgReadOnly)

	'-----------------------------------------------------------
	' ショートカットはショートカット先を開く
	'-----------------------------------------------------------
	Case "lnk"
		Set wshShortcut = WSH.CreateShortcut(strFile)
		' ショートカット先を再帰処理
		Call OpenFileNewWindow(wshShortcut.TargetPath, flgReadOnly)

	'-----------------------------------------------------------
	' その他
	'-----------------------------------------------------------
	Case Else
		WScript.Echo "未対応の拡張子です。" + vbNewline + FSO.GetFileName(strFile)

	End Select

End Sub


'***********************************************************
' ファイルを新しいウィンドウで開く (Excel)
'***********************************************************
Sub OpenFileNewExcel(strFile, flgReadOnly)
	Dim objExcelApp

	' Excelを起動
	Set objExcelApp = CreateObject("Excel.Application")

	' Excelを可視化
	objExcelApp.Visible = True

	' Excelでファイルを開く
	Call objExcelApp.Workbooks.Open(strFile, , flgReadOnly)

	' 参照を解放する
	' メモ：ＭＳを信じれば(足を)すくわれる
	Set objExcelApp = Nothing

End Sub


'***********************************************************
' ファイルを新しいウィンドウで開く (Word)
'***********************************************************
Sub OpenFileNewWord(strFile, flgReadOnly)
	Dim objWordApp

	' Wordを起動
	Set objWordApp = CreateObject("Word.Application")

	' Wordを可視化
	objWordApp.Visible = True

	' Wordでファイルを開く
	Call objWordApp.Documents.Open(strFile, , flgReadOnly)

	' 参照を解放する
	' メモ：ＭＳを信じれば(足を)すくわれる
	Set objWordApp = Nothing

End Sub


'***********************************************************
' ファイルを新しいウィンドウで開く (Powerpoint)
'***********************************************************
Sub OpenFileNewPowerpoint(strFile, flgReadOnly)
	Dim objPowerpointApp

	' PowerPointを起動
	' メモ：CreateObjectを使っても既存のプロセスが使いまわされる挙動になる(場合がある？)。
	Set objPowerpointApp = CreateObject("Powerpoint.Application")

	' PowerPointを可視化
	objPowerpointApp.Visible = True

	' PowerPointでファイルを開く
	Call objPowerpointApp.Presentations.Open(strFile, flgReadOnly)

	' 参照を解放する
	' メモ：ＭＳを信じれば(足を)すくわれる
	Set objPowerpointApp = Nothing

End Sub

更新履歴

2020/04/01　投稿
2020/04/07　タイトルと説明を更新

1. Multiple Document Interface の略。1つのウィンドウの中にファイル毎の子ウィンドウが並ぶUI方式。 ↩

2. Single Document Interface ファイル毎に独立したウィンドウを表示するUI方式。Excel2013/2016は厳密にはSDIではなくMTI(Multiple Top-level Interface)というらしい。 ↩

3. EXCEL.EXEをただ実行するだけだと既存のExcelプロセスが使いまわされる。Excelの新しいプロセスを立ち上げるには、ALTキーを押しながらEXCEL.EXEを実行する必要がある。 ↩