カスタム検索
その他

ドラッグ&ドロップでWordのテンプレートを登録・解除する(VBS)

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のスタートアップフォルダにすでに同名のテンプレートがある場合にはファイルを削除してテンプレートの登録を解除します。