アドインファイルの移動（再）

いったん解決したと思ったのですが、何度もテストしている間にグチャグチャになってしまっていたらしく、再起動してからクリーンな状態で検証するとダメでした。
http://oshiete.goo.ne.jp/qa/8026813.html

申し訳ありませんが、再掲いたします。

Excelのアドインファイルを移動する必要が出てきたのでVBAで移動させようとしています。
VBAは、アドインとは別のExcelファイルにコーディングしています。
アドインファイル名は MyAdd.xla とします。

MyAdd.xla を新フォルダに移動させることはできましたが、参照元の変更がうまくできません。
設定するPCの台数が多いので、自動で処理したいのです。
よろしくお願いします。

AddIns("MyAdd").Installed = False
AddIns.Add Filename:= "新フォルダパス\MyAdd.xla"
AddIns("MyAdd").Installed = True

No.5 回答者： cj_mover 回答日時： 2013/04/09 03:18

すみません。

編集ミスに気が付きました。
ＶＢＡコード冒頭の
On Error GoTo 0
は、直後の
End if
の下の行にあるべきですね。
失礼しました。

No.4 回答者： cj_mover 回答日時： 2013/04/09 02:48

こんにちは。

予想した以上に難しいですね。
とりあえず自宅の環境（64Win7/64XL2010）でようやく結果が出るもの
が書けたので参考として上げておきます。
しかし、やはり検証するだけの体力、時間、環境がありません。
私の感覚では１０％程度の出来ですが、継続的に開発するのは難しいので、
ヒントにでもなれば、という思いで提示するものです。
私のこのレスは前スレへのレスです。
（＃１の補足欄に書かれていることを文面通りに捉えると協力しにくい印象はありますね）
今のところ私はレジストリを書き換える以外の方法は考えられていません。
いつかパッと閃いて呆気ない程簡単な方法が見つかることを夢見たりする程冗長ですが、
部分的なパーツは色々流用できるかと思うので、参考になれば幸甚です。


' ' 〓〓〓〓〓〓〓〓〓〓標準モジュール専用〓〓〓〓〓〓〓〓〓〓
Option Explicit
Sub MoveAddInC()
Const S_ADD_IN_NAME = "MyAdd"
Const S_NEW_PATH = "移動先パス\" ' ←指定
Const S_FNM_SCRIPT = "AMover.vbs"
　　Dim arrLinks
　　Dim curAddIn As Excel.AddIn
　　Dim adn As Excel.AddIn
　　Dim wbk As Workbook
　　Dim sCurFullName As String
　　Dim sNewFullName As String
　　Dim sAppVer As String
　　Dim sScript As String
　　Dim i As Long
　　Dim nFf As Integer
　　Dim flgEsc As Boolean

' ' ==========　Workbooks の準備　==========
' ' ====================　ご自分で書いてください　=================
' ' "AddInを参照しているブック"を すべてを開きます。
' ' Excel.Application の終了準備の為、
' ' 開いているブック（アドイン含む）（当マクロを登録したブック含む）
' ' すべて、.Saved ＝ True の状態にしてください。
' ' ここで開かずに漏れてしまった"AddInを参照しているブック"
' ' については、後から手作業でリンクを書き直さなければなりません。
' ' なので、ここの記述、重要！！です。（他人には書けませんし）
' ' 尚、実行後、AddInを元のフォルダに戻すように再実行する前提なら、
' ' 当マクロを登録したブックが"AddInを参照しているブック"ならば、
' ' ブック単独でテスト可能です。
' ' →　Const S_NEW_PATH = "元あったフォルダパス\"
' ' ===============================================================

On Error Resume Next
　　Set curAddIn = AddIns(S_ADD_IN_NAME)
On Error GoTo 0
　　If Err.Number Then
　　　　MsgBox "アドイン見つからないよ！"
　　　　Exit Sub
　　End If
　　sCurFullName = curAddIn.FullName
　　sNewFullName = S_NEW_PATH & curAddIn.Name
　　If sCurFullName = sNewFullName Then
　　　　MsgBox "引越済？"
　　　　Exit Sub
　　End If

' ' ==========　AddIn　コピー（外部からの操作で　原本を残したまま移動）　==========
　　CreateObject("Scripting.FileSystemObject").CopyFile sCurFullName, sNewFullName
' ' ==========　AddIn　アンインストール　==========
　　curAddIn.Installed = False
' ' ==========　各ブック毎にリンク先を新しいAddInに変更して保存　==========
　　For Each wbk In Workbooks
　　　　arrLinks = wbk.LinkSources(xlExcelLinks)
　　　　If Not IsEmpty(arrLinks) Then
　　　　　　For i = 1 To UBound(arrLinks)
　　　　　　　　If arrLinks(i) = sCurFullName Then Exit For
　　　　　　Next i
　　　　　　' ' リンクされているブックだと確認できたら
　　　　　　If i <= UBound(arrLinks) Then
　　　　　　　　wbk.ChangeLink sCurFullName, sNewFullName, xlExcelLinks
　　　　　　　　wbk.Save
　　　　　　End If
　　　　End If
　　Next
' ' ==========　AddIn　インストール　==========
　　curAddIn.Installed = True
　　Set curAddIn = Nothing
' ' ==========　Application.Version 取得　==========
　　sAppVer = Format(Val(Application.Version), "0.0")
' ' ==========　VBScript 作成　==========
' ' -----　スクリプト合成　-----
sScript = "Dim cn" & vbCrLf & "Dim sRtn" & vbCrLf & _
"Const sRoot = ""HKEY_CURRENT_USER\Software\Microsoft\Office\" _
　　& sAppVer & "\Excel\Options\OPEN""" & vbCrLf & _
"GetObject(, ""Excel.Application"").Quit" & vbCrLf & _
"WScript.Sleep 100" & vbCrLf & _
"On Error Resume Next" & vbCrLf & _
"With CreateObject(""WScript.Shell"")" & vbCrLf & _
"cn = 0" & vbCrLf & _
"Do" & vbCrLf & _
"If cn > 0 Then" & vbCrLf & _
"sRtn = .RegRead(sRoot & cn)" & vbCrLf & _
"If Err <> 0 Then Exit Do" & vbCrLf & _
"If sRtn = """"""" & sCurFullName & """"""" Then" & vbCrLf & _
".RegWrite sRoot & cn, """"""" & sNewFullName & """""""" & vbCrLf & _
"Exit Do" & vbCrLf & "End If" & vbCrLf & "End If" & vbCrLf & _
"cn = cn + 1" & vbCrLf & "Loop" & vbCrLf & "End With" & vbCrLf & _
"MsgBox """ & sCurFullName & """ & vbLf & ""　　↓"" & vbLf & """ & _
　　sNewFullName & """ & vbLf & ""　　引越完了"" & vbLf & vbLf & ""Comments as U Like""" & vbCrLf & _
"CreateObject(""Scripting.FileSystemObject"").DeleteFile """ & sCurFullName & """" & vbCrLf & _
"CreateObject(""Scripting.FileSystemObject"").DeleteFile """ & S_FNM_SCRIPT & """"

' ' -----　VBSファイル出力　-----
　　nFf = FreeFile()
　　Open S_FNM_SCRIPT For Output As #nFf
　　Print #nFf, sScript;
　　Close #nFf
' ' ==========　VBScript 実行　==========
　　Shell "wscript """ & S_FNM_SCRIPT & """"
End Sub
' ' 〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

ＶＢＳの内容は、前スレで紹介したリンク先のコードの応用です。
レジストリを操作するものですから、扱いは慎重に。

ご相談やご質問があればお応えするつもりですが、
次に手を加えるのはだいぶ先になることと思います。

頑張ってください。それでは、また。　　　　　　　　　　　　

この回答への補足

何度もありがとうございます。
いただいたコードを理解するには私も膨大な時間が必要そうです。
ただ、レジストリを書き換えるとなると腰が引けてしまいます。対象となる環境は OSが Xp/Win7 Excelが 2003/2010 と組合せが４通りありますので。
既存ブックのリンク切り替えについては、メニューにアドインを組み込むことで対応できると思うのですが、とにかくアドインを引っ越さないことには、それも無理な話です。

> いつかパッと閃いて呆気ない程簡単な方法が見つかることを夢見たりする
色々と試してはみているのですが．．．手動でできることなのになんでマクロでできないのか。そもそもなんで Addins.Add と逆の動作をするメソッドが準備されていないのでしょうね（きっと複雑な事情があるんでしょうが）。

補足日時：2013/04/09 22:01

No.3 回答者： WindFaller 回答日時： 2013/04/08 20:55

>Excelのアドインファイルを移動する必要が出てきたのでVBAで移動させようとしています。

できないとは言わないけれども、インストールプログラムを作ると同じことではありませんか？

つまり、物理的にファイルを移動して、その後で、VBAでレジストリを書き換えるという意味ですよね。それよりも、インストールした後、手動でしたほうが楽だと思いますが。

前回の紹介されていたサイト（http://www.excel.studio-kazu.jp/kw/2011092118361 …にも、削除する側が出ていますから、逆をすればよいのは分かります。しかし、Excelのアプリ側に、手動ですが、移動して見失うとメッセージが出て、表示を削除し再登録ができたはずですね。

なお、ユーザーアドインの場所は、一般的には規定の位置にきまっているはずです。
Win7 でしたら、

Application.UserLibraryPath
　　 ということで、
C:\Users\[UserName]\AppData\Roaming\Microsoft\AddIns\

のはずです。レジストリ未登録とか、違ったままでもできるとは思うですが、使うたびに、アドインを、Run で呼び出しをするのは、かなり面倒ではないかと思うのです。

以下のリンク先は、どうも中途半端な内容で要領を得ませんでしたが、カスタム・アドインのインストール方法が出ていますが、この文章だけでは終わらないようです。

http://msdn.microsoft.com/library/office/aa16495 …
アプリケーションの固有のアドインの配置について（英語）
(Deploying Application-Specific Add-ins)

SHGetSpecialFolderLocation,
SHGetPathFromIDList,
SHGetMalloc

Sampleファイルが、VB6にはあるように書かれています。

この3つのWin APIとDLLを使えというようです。

http://office.microsoft.com/ja-jp/excel-help/HP0 …
ここでは、手動の説明しかありませんしね。

>アクセス権限を変更することも管理者から許可されていません
#2さんが先にかかれてしまいましたが、それでは、もともと無理なのではありませんか？

この回答への補足

ありがとうございます。
最悪手動も考えているのですが、XL2010 では開発環境を表示するところから説明しなければならず、末端ユーザには荷が重いのです。
末端ユーザは、アドインに収録されたユーザ定義関数を使った帳票を使うだけなのです。

補足日時：2013/04/09 21:46

No.2 回答者： bignishi 回答日時： 2013/04/08 20:10

回答しましたBIGNISHIです。

回答に対する返信で、質問の内容が理解できました。
先程回答した内容は的外れで申し訳ありませんでした。

質問の内容は、”アドインモジュールをローディングする際に、Excel規定外のホルダーからローディングするための
方法はどうするのか”とのことだと思います。

御社の情報管理規則から推測しますには、自作・他作を問わず認可されていないモジュール（プログラム）をインストール
する事は、出来ないのではないかと思います。

ご質問案件を実現するには先ず、インストールするアドインモジュールのインストール許可を受けることが最善と考えます。
例え、別手順でインストール対応のプログラム（方法）を準備したとしても、セキュリティの上からも認可されていない
プログラムやアドインモジュールをインストールすることは出来ないのではないでしょうか。

以上

この回答への補足

ありがとうございます。
アドインには業務に使用するユーザ定義関数をまとめてあります。
XpのExcel規定フォルダは C:\Documents and Settings\ユーザーアカウント名\Application Data\Microsoft\Addins ですが、ここにアドインを保存すると、ユーザ定義関数を使ったブックを他の人に配布した時にリンクが切れてしまいます（配布先にもアドインが設定されているという前提で）。
それを回避するため C:\Program Files\Microsoft Office\Office12\Library に保存することを検討していたのですが、Win7ではこのフォルダもシステム管理下になっているとわかり、打つ手がなくなった次第です。
調べたところ、隠しフォルダですが Win7の C:\ProgramData の下は書き込み可能と判りました。
Xp側には C:\ProgramData を作成し、双方で同じフォルダ名を使用できる環境を作るのが目的です。

補足日時：2013/04/09 21:39

No.1 回答者： bignishi 回答日時： 2013/04/08 13:18

回答例

単にアドインファイル（Excel）をコピー（移動）するのであれば、下記の方法で問題無くコピーできると思います。
但し、
質問内容に記載されている、Addins("My.......)・・・・とコピーの関連及び運用方法やExcelのバージョン等が
不明の為、参考例として記載しております。

------------<>--------------------------------------
Option Explicit
Dim SndNM, RcvNm As String

Sub CopyTest()
SndNM = "ｄ:\????????????.xla"　：コピー元のファイルを指定
RcvNm = "ｃ:\----------.xla"　：コピー先のファイルを指定
'--
FileCopy Source:=SndNM, Destination:=RcvNm
End Sub

以上

この回答への補足

ありがとうございます。
MyAdd.xla の移動まではできていますが、Excel側でアドインの参照先を変更するのがうまくできません。
現在 Xpですが Win7 に移行するため、アドインの保存先を変更しなければなりません。現在のアドインフォルダが C:\直下にあるのですが、Win7 ではそこへのアクセスが許可されていません。
アクセス権限を変更することも管理者から許可されていません。

補足日時：2013/04/08 14:43