「Wordのスタートアップフォルダを開く(VBS)」でWordのスタートアップフォルダを開くVBScriptを紹介しましたが、今回はその応用でスクリプトファイルにWordのテンプレートファイルをドラッグ&ドロップすることで、テンプレートの登録と解除を行うスクリプトを紹介します。
Option Explicit
Dim Args
Dim TemplateFileName
Dim TemplateFilePath
Dim StartupFolderPath
Const MsgTitle = "Wordテンプレートファイル登録・解除スクリプト"
'拡張子識別
Set Args = WScript.Arguments
If Args.Count < 1 Then
MsgBox "Wordに登録・解除したいテンプレートファイルを" & vbCrLf & _
"当スクリプトファイルにドラッグ&ドロップして" & vbCrLf & _
"処理を実行してください。", 16, MsgTitle
WScript.Quit
End If
With CreateObject("Scripting.FileSystemObject")
Select Case LCase(.GetExtensionName(Args(0)))
Case "dot", "dotx", "dotm"
TemplateFileName = .GetFileName(Args(0))
TemplateFilePath = Args(0)
Case Else
MsgBox "Wordテンプレートファイルではありません。" & vbCrLf & "処理を中止します。", 16, MsgTitle
WScript.Quit
End Select
End With
Set Args = Nothing
'アプリケーション起動チェック
If ChkApp Then
MsgBox "Wordが起動しています。" & vbCrLf & "Wordを終了してから再度実行してください。", 16, MsgTitle
WScript.Quit
End If
'スタートアップフォルダのパス取得
StartupFolderPath = GetStartupPath
If Len(StartupFolderPath) < 1 Then
MsgBox "スタートアップフォルダのパスの取得に失敗しました。", 16, MsgTitle
WScript.Quit
End If
If Right(StartupFolderPath, 1) <> "\" Then StartupFolderPath = StartupFolderPath & "\"
'テンプレートファイルのコピー・削除
On Error Resume Next
With CreateObject("Scripting.FileSystemObject")
If .FolderExists(StartupFolderPath) <> True Then
MsgBox "スタートアップフォルダが見つかりませんでした。", 16, MsgTitle
WScript.Quit
End If
'テンプレートファイルがすでに存在している場合は削除
If .FileExists(StartupFolderPath & TemplateFileName) Then
.DeleteFile StartupFolderPath & TemplateFileName
MsgBox "テンプレートファイルの登録を解除しました。", 64, MsgTitle
WScript.Quit
Else
.CopyFile TemplateFilePath, StartupFolderPath, True 'ファイルコピー(上書き)
End If
End With
If Err.Number <> 0 Then
MsgBox "エラーが発生しました。" & vbCrLf & "エラー内容 : " & Err.Description, 16, MsgTitle
Err.Clear
WScript.Quit
End If
On Error GoTo 0
If MsgBox("テンプレートファイルを登録しました。" & vbCrLf & "Wordを今すぐ起動しますか?", vbYesNo, MsgTitle) = vbYes Then
CreateObject("WScript.Shell").Run "WINWORD.EXE", 1, False
End If
'スタートアップフォルダのパス取得
Private Function GetStartupPath()
Dim ret
ret = "" '初期化
On Error Resume Next
With CreateObject("Word.Application")
.Visible = False
ret = .StartupPath
.Quit 0
End With
Err.Clear
On Error GoTo 0
GetStartupPath = ret
End Function
'Wordの起動チェック
Private Function ChkApp()
Dim app, ret
ret = False '初期化
On Error Resume Next
Set app = GetObject(, "Word.Application")
Err.Clear
On Error GoTo 0
If Not IsEmpty(app) Then ret = True
ChkApp = ret
End Function
上記コードのvbsファイルに下図のようにWordテンプレートファイル(dot,dotx,dotm)をドラッグ&ドロップすると、そのテンプレートをWordに登録することができます。
テンプレートファイルをドラッグ&ドロップしたとき、Wordのスタートアップフォルダにすでに同名のテンプレートがある場合にはファイルを削除してテンプレートの登録を解除します。