Office関連

ドラッグ&ドロップでExcelのアドインを登録するVBScript

ドラッグ&ドロップでWordのテンプレートを登録・解除する(VBS)」でWordテンプレートの登録・解除を補佐するスクリプトを紹介しましたが、今回はドラッグ&ドロップでExcelのアドインを登録するスクリプトを紹介します。

下記コードは、

  1. Excelのアドインフォルダのパスを取得
  2. ドラッグ&ドロップされたアドインファイルをExcelのアドインフォルダにコピー
  3. コピーしたアドインファイルを登録

といった作業を自動的に行います。
アドインファイルのコピー先を変更したい、複数のアドインファイルを同時に登録したい、といった場合には、適当にコードを変更してご使用ください。

Option Explicit

InstallAddIn()
If MsgBox("処理が終了しました。" & vbCrLf & "Excelを今すぐ起動しますか?", vbYesNo) = vbYes Then _
CreateObject("WScript.Shell").Run "EXCEL.EXE", 1, False

Public Sub InstallAddIn()
  Dim Args
  Dim SourceFilePath
  Dim AddInFileName
  Dim AddInFilePath
  Dim AddInFolderPath
  Dim Wb
  Const MsgTitle = "Excelアドインファイル登録スクリプト"
  
  Set Args = WScript.Arguments
  If Args.Count < 1 Then
    MsgBox "Excelに登録したいアドインファイルを" & vbCrLf & _
           "当スクリプトファイルにドラッグ&ドロップして" & vbCrLf & _
           "処理を実行してください。", 16, MsgTitle
    Exit Sub
  ElseIf Args.Count > 1 Then
    MsgBox "当スクリプトが一度に処理できるのは1ファイルだけです。" & vbCrLf & _
           "処理を中止します。", 16, MsgTitle
    Exit Sub
  End If
  With CreateObject("Scripting.FileSystemObject")
    Select Case LCase(.GetExtensionName(Args(0)))
      Case "xla", "xlam"
        AddInFileName = .GetFileName(Args(0))
        SourceFilePath = Args(0)
      Case Else
        MsgBox "Excelアドインファイルではありません。" & vbCrLf & "処理を中止します。", 16, MsgTitle
        Exit Sub
    End Select
  End With
  Set Args = Nothing
  
  'アプリケーション起動チェック
  If ChkApp Then
    MsgBox "Excelが起動しています。" & vbCrLf & "Excelを終了してから再度実行してください。", 16, MsgTitle
    Exit Sub
  End If
  
  'アドインフォルダのパス取得
  AddInFolderPath = GetUserLibraryPath()
  If Len(AddInFolderPath) < 1 Then
    MsgBox "アドインフォルダのパスの取得に失敗しました。", 16, MsgTitle
    Exit Sub
  End If
  If Right(AddInFolderPath, 1) <> "\" Then AddInFolderPath = AddInFolderPath & "\"
  AddInFilePath =  AddInFolderPath & AddInFileName
  
  'アドインファイルのコピー
  On Error Resume Next
  With CreateObject("Scripting.FileSystemObject")
    If .FolderExists(AddInFolderPath) <> True Then
      MsgBox "アドインフォルダが見つかりませんでした。", 16, MsgTitle
      Exit Sub
    End If
    If .FileExists(AddInFilePath) Then
      MsgBox "すでに[" & AddInFilePath & "]が存在しています。" & vbCrLf & _
             "処理を中止します。", 16, MsgTitle
      Exit Sub
    End If
    .CopyFile SourceFilePath, AddInFolderPath, True 'ファイルコピー(上書き)
  End With
  
  'アドインの登録
  With CreateObject("Excel.Application")
    .Visible = True
    Set Wb = .Workbooks.Add()
    .AddIns.Add(AddInFilePath).Installed = True
    Wb.Close False
    .Quit
  End With
  If Err.Number <> 0 Then
    MsgBox "エラーが発生しました。" & vbCrLf & "エラー内容 : " & Err.Description, 16, MsgTitle
    Err.Clear
    Exit Sub
  End If
  On Error GoTo 0
End Sub

'アドインフォルダのパス取得
Private Function GetUserLibraryPath()
  Dim ret
  
  ret = "" '初期化
  On Error Resume Next
  With CreateObject("Excel.Application")
    .Visible = False
    ret = .UserLibraryPath
    .Quit
  End With
  Err.Clear
  On Error GoTo 0
  GetUserLibraryPath = ret
End Function

'Excelの起動チェック
Private Function ChkApp()
  Dim app, ret
  
  ret = False '初期化
  On Error Resume Next
  Set app = GetObject(, "Excel.Application")
  Err.Clear
  On Error GoTo 0
  If Not IsEmpty(app) Then ret = True
  ChkApp = ret
End Function

■ 使い方

  1. 上記コードをコピーしてメモ帳に貼り付けます。
  2. 拡張子を「vbs」にして保存します。
  3. Excelを終了した状態で、手順2.で保存したvbsファイルにExcelのアドインファイル(xla,xlam)をドラッグ&ドロップします。

PowerPointの自動実行マクロ前のページ

WebページのテーブルがExcelに!? ― Excel 対話型ビュー(Interactive View)の紹介次のページ

関連記事

  1. Office関連

    「いちばんやさしいExcel VBAの教本」レビュー

    VBAの学習者であれば一度は見たことがあるであろう、超有名老舗サイト「…

  2. VBScript

    Windowsのバージョン情報を取得する

    小ネタです。verコマンドを利用してWindowsのバージ…

  3. Office関連

    Adobe Readerを利用してPDFファイルのページ数を取得するVBAマクロ

    mougの回答用に書いたコードです。mougは半年でログが消えてし…

  4. Office関連

    代替テキストを削除するPowerPointマクロ

    PowerPointの図やSmartArt、グループやグラフといった視…

コメント

  1. この記事へのコメントはありません。

  1. この記事へのトラックバックはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

PAGE TOP