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関連

    PDFファイルのフィールドを読み取り専用にするVBAマクロ

    「PDFのフィールドに値を入力した後、読み取り専用にするにはどうしたら…

  2. Office アドイン

    [Office用アプリ]User Agent他を調べてみました。

    ふと気になったので、Office 用アプリをローカル環境にインストール…

  3. Office関連

    インストールされているアプリケーション一覧を取得するVBAマクロ

    端末にインストールされているアプリケーション名を調べる必要があったので…

  4. アイコン一覧

    Office 2013 アイコン一覧(P)

    ・Office 2013 アイコン一覧 NUM…

  5. Office関連

    漢字かな交じり文をひらがなにするマクロ

    Yahoo!のテキスト解析Web API(ルビ振り)を使用して、漢字か…

コメント

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

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

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP