読取専用で開く
以下を 読取専用で開く.vbs というファイル名で保存し、
送るメニューに登録する。
C:\Document and Settings\<user>\SendTo
読取専用で開く.vbs
'*********************************************************************
'* MS-Officeファイルを読取専用でOpen
'*********************************************************************
Option Explicit
Const TITLE = "MS-Officeファイルを読取専用でOpen"
' コマンドライン引数のチェック
Dim args, fileName
Set args = WScript.Arguments
If (0 = args.Count) Then
MsgBox "ファイル名が指定されていません", , TITLE
WScript.Quit
End If
fileName = args(0)
' ファイルシステムオブジェクトを取得
Dim fsObj
Set fsObj = CreateObject("Scripting.FileSystemObject")
' コマンドラインで指定されたファイルの有無をチェック
If (Not fsObj.FileExists(fileName)) Then
MsgBox fsObj.GetFileName(fileName) & "は存在しません", , TITLE
WScript.Quit
End If
' ファイルの拡張子で、処理を振り分け
Dim ext
ext = LCase(fsObj.GetExtensionName(fileName))
Dim app
Dim wshShell
Set wshShell = WScript.CreateObject("WScript.Shell")
On Error Resume Next
If (InStr(ext, "xls") > 0) Then
'Excelで開く
Set app = GetObject(, "Excel.Application")
If (Err.Number <> 0) Then
Set app = CreateObject("Excel.Application")
app.Visible = True
End If
app.WorkBooks.Open fileName, , True
wshShell.AppActivate app.Caption
ElseIf (InStr(ext, "doc") > 0) Then
'Wordで開く
Set app = GetObject(, "Word.Application")
If (Err.Number <> 0) Then
Set app = CreateObject("Word.Application")
app.Visible = True
End If
app.Documents.Open fileName, , True
wshShell.AppActivate app.Caption
ElseIf (InStr(ext, "ppt") > 0) Then
'Wordで開く
Set app = GetObject(, "Powerpoint.Application")
If (Err.Number <> 0) Then
Set app = CreateObject("Powerpoint.Application")
app.Visible = True
End If
app.Presentations.Open fileName, True
wshShell.AppActivate app.Caption
ElseIf (InStr(ext, "vsd") > 0) Then
'Visioで開く
Set app = GetObject(, "Visio.Application")
If (Err.Number <> 0) Then
Set app = CreateObject("Visio.Application")
app.Visible = True
End If
' Microsoft.Office.Interop.Visio.VisOpenSaveArgs.visOpenRO = 2
Set ret = app.Documents.OpenEx(fileName, 2)
wshShell.AppActivate app.Caption
Else
MsgBox ext & "ファイルには対応していません。m(_ _)m", , TITLE
End If
Set wshShell = Nothing
Set app = Nothing
Set fsObj = Nothing別プロセスで開く
以下を 別プロセスで開く.vbs というファイル名で保存し、
送るメニューに登録する。
C:\Document and Settings\<user>\SendTo
別プロセスで開く.vbs
'*********************************************************************
'* MS-Officeファイルを別プロセスでOpen
'*********************************************************************
Option Explicit
Const TITLE = "MS-Officeファイルを別プロセスでOpen"
' コマンドライン引数のチェック
Dim args, fileName
Set args = WScript.Arguments
If (0 = args.Count) Then
MsgBox "ファイル名が指定されていません", , TITLE
WScript.Quit
End If
fileName = args(0)
' ファイルシステムオブジェクトを取得
Dim fsObj
Set fsObj = CreateObject("Scripting.FileSystemObject")
' コマンドラインで指定されたファイルの有無をチェック
If (Not fsObj.FileExists(fileName)) Then
MsgBox fsObj.GetFileName(fileName) & "は存在しません", , TITLE
WScript.Quit
End If
' ファイルの拡張子で、処理を振り分け
Dim ext
ext = LCase(fsObj.GetExtensionName(fileName))
Dim app
Dim wshShell
Set wshShell = WScript.CreateObject("WScript.Shell")
On Error Resume Next
If (InStr(ext, "xls") > 0) Then
'Excelで開く
Set app = CreateObject("Excel.Application")
app.Visible = True
app.WorkBooks.Open fileName
wshShell.AppActivate app.Caption
ElseIf (InStr(ext, "doc") > 0) Then
'Wordで開く
Set app = CreateObject("Word.Application")
app.Visible = True
app.Documents.Open fileName
wshShell.AppActivate app.Caption
ElseIf (InStr(ext, "ppt") > 0) Then
'Wordで開く
Set app = CreateObject("Powerpoint.Application")
app.Visible = True
app.Presentations.Open fileName
wshShell.AppActivate app.Caption
ElseIf (InStr(ext, "vsd") > 0) Then
'Visioで開く
Set app = CreateObject("Visio.Application")
app.Visible = True
Set ret = app.Documents.OpenEx(fileName)
wshShell.AppActivate app.Caption
Else
MsgBox ext & "ファイルには対応していません。m(_ _)m", , TITLE
End If
Set wshShell = Nothing
Set app = Nothing
Set fsObj = Nothing