Skip to content

Commit 75c4af5

Browse files
committed
アドインフォルダを Application.UserLibraryPath より取得するように修正。
1 parent 6c70665 commit 75c4af5

2 files changed

Lines changed: 50 additions & 41 deletions

File tree

Version.txt

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
2020/12/06(sun) RelaxTools-Addin Version 4.27.1(RustRemover)
22
◇機能追加
3-
・背景に文字列を表示して注意喚起する機能です。印刷はされませんので注意。
3+
・「RelaxApps」→「背景の設定」を追加
4+
 背景に文字列を表示して注意喚起する機能です。印刷はされませんので注意。
45
 「セル結合禁止」は りゅうりゅう(Twitter@blacklist_ryu) さん考案の機能ですが
56
 便乗して「河野太郎内閣府特命担当大臣」の「機械判読可能なデータの表記方法の統一ルール案」の一部を
67
 表示する機能として追加しました。

install.vbs

Lines changed: 48 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,20 @@
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
1618
On Error Resume Next
1719

1820
Dim installPath
@@ -21,6 +23,12 @@ Dim addInFileName
2123
Dim objExcel
2224
Dim objAddin
2325
Dim imageFolder
26+
Dim appFile
27+
Dim objWshShell
28+
Dim objFileSys
29+
Dim strPath
30+
Dim objFolder
31+
Dim objFile
2432

2533
'アドイン情報を設定
2634
addInName = "RelaxTools Addin"
@@ -29,62 +37,63 @@ appFile = "rlxAliasOpen.vbs"
2937

3038
Set objWshShell = CreateObject("WScript.Shell")
3139
Set objFileSys = CreateObject("Scripting.FileSystemObject")
32-
Set objShell = CreateObject("Shell.Application")
3340

3441
IF Not objFileSys.FileExists(addInFileName) THEN
35-
MsgBox "Zipファイルを展開してから実行してください。", vbExclamation, addInName
36-
WScript.Quit
42+
MsgBox "Zipファイルを展開してから実行してください。", vbExclamation, addInName
43+
WScript.Quit
3744
END 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-
4546
IF MsgBox(addInName & " をインストールしますか?" & vbCrLf & "Version 4.0.0 以降とそれ以前では設定が引き継がれませんのでご了承ください。", vbYesNo + vbQuestion, addInName) = vbNo Then
46-
WScript.Quit
47+
WScript.Quit
4748
End 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

7888
IF 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

8695
ELSE
87-
MsgBox "エラーが発生しました。" & vbCrLF & "Excelが起動している場合は終了してください。", vbExclamation, addInName
96+
MsgBox "エラーが発生しました。" & vbCrLF & "Excelが起動している場合は終了してください。", vbExclamation, addInName
8897
WScript.Quit
8998
End IF
9099

@@ -98,6 +107,5 @@ End IF
98107

99108
objWshShell.Run "ExcelReadOnly.vbs", 1, true
100109

101-
110+
Set objFileSys = Nothing
102111
Set objWshShell = Nothing
103-

0 commit comments

Comments
 (0)