11' -------------------------------------------------------------------------------
2- ' RelaxTools-Addin インストールスクリプト Ver.1.0.5
2+ ' RelaxTools-Addin インストールスクリプト Ver.1.0.6
33' -------------------------------------------------------------------------------
44' 参考サイト
55' ある SE のつぶやき
66' VBScript で Excel にアドインを自動でインストール/アンインストールする方法
77' http://fnya.cocolog-nifty.com/blog/2014/03/vbscript-excel-.html
88' 修正
9+ ' 1.0.6 インストールパスを Application.UserLibraryPath を利用するように修正。
910' 1.0.5 同名ブックを参照用に開くVBSをインストールするよう修正。
1011' 1.0.4 マルチプロセス用VBSが不要になったので削除。
1112' 1.0.3 マルチプロセス用VBSをコピーするよう修正。
1213' 1.0.3 images フォルダをコピーするように修正。
1314' 1.0.2 Windows Update にて インターネットより取得したアドインファイルが Excel にて読み込まれない場合に対応。
1415' 警告とプロパティウィンドウを表示して「ブロック解除」をお願いするようにした。
1516' -------------------------------------------------------------------------------
17+ Option Explicit
1618On Error Resume Next
1719
1820Dim installPath
@@ -21,6 +23,12 @@ Dim addInFileName
2123Dim objExcel
2224Dim objAddin
2325Dim imageFolder
26+ Dim appFile
27+ Dim objWshShell
28+ Dim objFileSys
29+ Dim strPath
30+ Dim objFolder
31+ Dim objFile
2432
2533'アドイン情報を設定
2634addInName = "RelaxTools Addin"
@@ -29,62 +37,63 @@ appFile = "rlxAliasOpen.vbs"
2937
3038Set objWshShell = CreateObject( "WScript.Shell" )
3139Set objFileSys = CreateObject( "Scripting.FileSystemObject" )
32- Set objShell = CreateObject( "Shell.Application" )
3340
3441IF Not objFileSys.FileExists(addInFileName) THEN
35- MsgBox "Zipファイルを展開してから実行してください。" , vbExclamation, addInName
36- WScript.Quit
42+ MsgBox "Zipファイルを展開してから実行してください。" , vbExclamation, addInName
43+ WScript.Quit
3744END IF
3845
39- 'インストール先パスの作成
40- '(ex)C:\Users\[User]\AppData\Roaming\Microsoft\AddIns\[addInFileName]
41- strPath = objWshShell.SpecialFolders( "Appdata" ) & "\Microsoft\Addins\"
42- installPath = strPath & addInFileName
43- imageFolder = objWshShell.SpecialFolders( "Appdata" ) & "\RelaxTools-Addin\"
44-
4546IF MsgBox(addInName & " をインストールしますか?" & vbCrLf & "Version 4.0.0 以降とそれ以前では設定が引き継がれませんのでご了承ください。" , vbYesNo + vbQuestion, addInName) = vbNo Then
46- WScript.Quit
47+ WScript.Quit
4748End IF
4849
49- 'ファイルコピー(上書き)
50- objFileSys.CopyFile addInFileName ,installPath , True
50+ 'Excel インスタンス化
51+ With CreateObject( "Excel.Application" )
5152
52- 'イメージフォルダがない場合は作成
53- IF Not objFileSys.FolderExists(imageFolder) THEN
54- objFileSys.CreateFolder(imageFolder)
55- END IF
53+ 'インストール先パスの作成
54+ strPath = .UserLibraryPath
55+ imageFolder = objWshShell.SpecialFolders( "Appdata" ) & "\RelaxTools-Addin\"
5656
57- 'イメージフォルダをコピー(上書き)
58- objFileSys.CopyFolder "Source\customUI\images" ,imageFolder , True
57+ 'インストールフォルダがない場合は作成
58+ IF Not objFileSys.FolderExists(strPath) THEN
59+ objFileSys.CreateFolder(strPath)
60+ END IF
5961
60- 'ファイルをコピー(上書き)
61- objFileSys.CopyFile appFile, imageFolder & appFile, True
62+ installPath = strPath & addInFileName
6263
63- Set objFileSys = Nothing
64+ 'ファイルコピー(上書き)
65+ objFileSys.CopyFile addInFileName ,installPath , True
6466
65- 'Excel インスタンス化
66- Set objExcel = CreateObject( "Excel.Application" )
67- objExcel.Workbooks.Add
67+ 'イメージフォルダがない場合は作成
68+ IF Not objFileSys.FolderExists(imageFolder) THEN
69+ objFileSys.CreateFolder(imageFolder)
70+ END IF
6871
69- 'アドイン登録
70- Set objAddin = objExcel.AddIns.Add(installPath, True )
71- objAddin.Installed = True
72+ 'イメージフォルダをコピー(上書き)
73+ objFileSys.CopyFolder "Source\customUI\images" ,imageFolder , True
7274
73- 'Excel 終了
74- objExcel.Quit
75- Set objAddin = Nothing
76- Set objExcel = Nothing
75+ 'ファイルをコピー(上書き)
76+ objFileSys.CopyFile appFile, imageFolder & appFile, True
77+
78+ 'アドイン登録
79+ .Workbooks.Add
80+ Set objAddin = .AddIns.Add(installPath, True )
81+ objAddin.Installed = True
82+
83+ 'Excel 終了
84+ .Quit
85+
86+ End WIth
7787
7888IF Err.Number = 0 THEN
79- MsgBox "アドインのインストールが終了しました。" , vbInformation, addInName
89+ MsgBox "アドインのインストールが終了しました。" , vbInformation, addInName
8090
81- Set objFolder = objShell.NameSpace(strPath)
82- Set objFile = objFolder.ParseName(addInFileName)
83- objFile.InvokeVerb( "properties" )
84- MsgBox "インターネットから取得したファイルはExcelよりブロックされる場合があります。" & vbCrlf & "プロパティウィンドウを開きますので「ブロックの解除」を行ってください。" & vbCrLf & vbCrLf & "プロパティに「ブロックの解除」が表示されない場合は特に操作の必要はありません。" , vbExclamation, addInName
91+ 'プロパティファイル表示
92+ CreateObject( "Shell.Application" ).NameSpace(strPath).ParseName(addInFileName).InvokeVerb( "properties" )
93+ MsgBox "インターネットから取得したファイルはExcelよりブロックされる場合があります。" & vbCrlf & "プロパティウィンドウを開きますので「ブロックの解除」を行ってください。" & vbCrLf & vbCrLf & "プロパティに「ブロックの解除」が表示されない場合は特に操作の必要はありません。" , vbExclamation, addInName
8594
8695ELSE
87- MsgBox "エラーが発生しました。" & vbCrLF & "Excelが起動している場合は終了してください。" , vbExclamation, addInName
96+ MsgBox "エラーが発生しました。" & vbCrLF & "Excelが起動している場合は終了してください。" , vbExclamation, addInName
8897 WScript.Quit
8998End IF
9099
@@ -98,6 +107,5 @@ End IF
98107
99108objWshShell.Run "ExcelReadOnly.vbs" , 1 , true
100109
101-
110+ Set objFileSys = Nothing
102111Set objWshShell = Nothing
103-
0 commit comments