エクセルＶＢＡでショートカットリンクの変更をするには

Question

エクセルＶＢＡで既存のショートカットファイル（～.lnk）のリンク先を変更するにはどうしたらよいでしょうか？
既に出来ているショートカットのリンク先を調べ、条件に一致した場合、そのリンク先を変更するＶＢＡを作成したいと思っています。
ＷＳＨを使ってショートカットを作る方法は知っていますが、既存のショートカットのリンク先を調べる方法が分かりません。

用途は以下の通りです。
会社のサーバが変更になり、ネットワークドライブの割り当てを変更するように通達がありましたが、既にショートカットは数百個あり、手で修正するのが非常に大変です。
ドライブ又はフォルダを指定して、そのフォルダ内及びその配下にある全てのサブフォルダにある全てのショートカットファイルを調べ対象の場合、登録したあったリンクの内容を自動変更します。
（ルートフォルダの指定及びサブフォルダの移動部分のＶＢＡは作成隅です。）

Qドライブのネットワーク割り当て
変更前：\Domain01\Kanto\Tokyo\
変更後：\Domain01\Kanto\
ファイルの指定
変更前：Q:\Kaihatsu1\Keikaku01.xls
変更後：Q:\Tokyo\Kaihatsu1\Keikaku01.xls

以上、よろしくお願い申し上げます。

Wendy02 · Accepted Answer

こんにちは。

昨日から、ネットワークを組もうと格闘しているのですが、もともと、ネットワークを組むための前のパソコンが調子が悪くて、エラーを出した挙句に、起動できなくなって、今回の実験環境が整いません。

>Windows2000Pro Office2000の環境です。

>これを解決する目処はたっていませんが、何とかしたいと考えております。

こういう時は、可能性のあることは、全部試してみるのがよいし、場合によっては、Wsh からやっても良いと思います。ともかく、こちらでは環境による違いは、試すことが出来ません。

当面、こういう時には、一度、参照設定で事前バインディングして試してみるのが良いかもしれませんね。パフォーマンスが変わります。（ダメ元ですが）

Wscript.Shell　　→Windows Script Host Object Model

Dim WSHShell As WSHShell　　'←ちょっとまずいですね（^^;

'Set WSHShell = CreateObject("Wscript.Shell")
　　　↓
Set WSHShell = New WSHShell

でも、あまりあれこれ考えるよりも、始めからダメだと決めて進めたほうが簡単だったりしますね。それは、Dir で取ったものに、情報を確保してから、、*.lnk を、*.bak でRename するか、Kill で削除して、新たに、その情報から、*.lnk のショートカットを作ればよいのですね。やっていることは同じですから。それで、出来ないとなれば、また、話は別です。

Wendy02 · Answer

こんばんは。

ほっとしました。;; そういう私は、今回、ネットワーク化はついに間に合わないというのか、壊れたパソコンには、ネットワーク化は、うまく行かないようです。こちらは欠陥状態のままで、なんとか最後まで行き着けたことは、私としても、うれしい限りです。

今回、私自身、チェック用のマクロも出来たし、ふだんは、考えないようなことに対して、勉強させていただきました。

Wendy02 · Answer

こんにちは。

しばらく検証してみました。

>フォルダのショートカットを修正すると、どういう訳か属性が変わってしまうようです。
>変更後のショートカットをクリックすると、フォルダが開かずファイルを開くプログラムの選>択が出てきてしまいます。

1)は、製作時のミスでしたが、2) のほうは、MSのサポートを見ると、共有フォルダのショートカットに対しては、ずいぶん作り方が違いようですから、それに関してはなんともいえないのですが、一般フォルダのショートカットとは違うのかもしれません。

ショートカットは、Windows の配下で、クリックすると、実際にそれがあるのか探しています。

だから、置換するときには、そのリンク先が存在していることと、置換した後に、正しく変わっているか、以下のマクロで、一度プロパティで調べていただくぐらいしか、今のところ言えません。

基本的には、TargetPath 内の文字列を置換すれば、稼動するのではないかとは思っていますが、ただ、もしかしたら、一旦、共有フォルダが利用できる状態を確保しておいてから、置換しないといけないかもしれません。そうすると、少し内容の趣も違ってきてしまいます。

こちらは、スタンドアロンで、まったく必要もないので、共有フォルダは、今のところ作っていません。

そのご様子ですと、ショートカットは、フォルダという認識をしていませんね。とりあえず、必要な情報を取るマクロを置いておきます。
以下のフルネーム(fullname)の「ショートカット名」だけは、読み取り専用です。

テスト用
------------------------------------------------------
Sub ShowShortCutProperties()
　　'ショートカット検査用マクロ
　　Dim ful, tp, dsp, arg, rel, wd, hk
　　Dim objFSO As Object 'FileSystemObject
　　Dim objFile As Object　'File
　　Dim objFolder As Object 'Folder
　　Dim WSHShell As Object
　　Dim msg As String
　　
　　Dim fn As String
　　Dim bln As Boolean
　　Dim rdy As String
　　
　　fn = "xxxx.lnk"　'ファイル名(*.lnk)
　　Set objFSO = CreateObject("Scripting.FileSystemObject")
　　If Dir(fn) = "" Then
　　　　MsgBox fn & "　が見つかりません", 64: Exit Sub
　　End If
　　Set objFile = objFSO.GetFile(fn)
　　With objFile
　　　　If InStr(1, .Type, "ショートカット", vbTextCompare) = 0 Then
　　　　　　 MsgBox "ショートカットファイルではありません。", 64: Exit Sub
　　　　End If
　　End With
　　Set WSHShell = CreateObject("Wscript.Shell")
　　With WSHShell.CreateShortcut(fn)
　　　　ful = .FullName
　　　　tp = .TargetPath
　　　　dsp = .Description
　　　　arg = .Arguments
　　　　'　 rel = .RelativePath
　　　　wd = .WorkingDirectory
　　　　hk = .Hotkey
　　End With
　　msg = "ショートカット名: " & ful & vbCrLf & _
　　"リンク先: " & tp & vbCrLf & _
　　"コメント: " & dsp & vbCrLf & _
　　"引数: " & arg & vbCrLf & _
　　"RelativePath: " & rel & vbCrLf & _
　　"作業用フォルダ: " & wd & vbCrLf & _
　　"ショートカットキー: " & hk & vbCrLf
　　
　　Set objFolder = objFSO.GetFolder(tp)
　　bln = objFile.Drive.IsReady
　　rdy = IIf(bln, "リンク先利用可", "リンク先利用不可")
　　msg = msg & vbCrLf & rdy
　　MsgBox msg
　　Set objFile = Nothing
　　Set objFolder = Nothing
　　Set objFSO = Nothing
　　Set WSHShell = Nothing
End Sub

Wendy02 · Answer

こんばんは。

ちょっと考えてみました。一気にしないで、ステップマクロなどで試してみてください。
ただ、ある程度のファイルの移動は検索するので、自動的にリンク先がつなぎ変わるようですね。


Sub MacroTest1()
Dim WSHShell As Object
Dim myPath As String
Dim fn As String
Dim i As Integer
Dim flg As Boolean
Dim p(1) As String

myPath = **************** & ""　　'リンクのあるパス
Set WSHShell = CreateObject("Wscript.Shell")

fn = Dir(myPath & "*.lnk")

Do While fn <> ""
With WSHShell.CreateShortcut(fn)
　　p(0) = .TargetPath
　　p(1) = .WorkingDirectory
　 For i = 0 To 1
　　'作業フォルダのために、末尾は \ を入れないほうが良いようです。
　　If InStr(p(i), "\Domain01\Kanto\Tokyo") > 0 Then
　　　p(i) = Replace(p(i), "\Domain01\Kanto\Tokyo", "\Domain01\Kanto")
　　　flg = True
　　ElseIf InStr(p(i), "Q:\Kaihatsu1") > 0 Then
　　　p(i) = Replace(p(i), "Q:\Kaihatsu1", "Q:\Tokyo\Kaihatsu1")
　　　flg = True
　　End If
　Next i
　　If flg Then
　　　　.TargetPath = p(0)
　　　　.WorkingDirectory = p(1)
　　　　.Save
　　　　Erase p()
　　End If
　　flg = False
　
fn = Dir()
End With
Loop
Set WSHShell = Nothing
End Sub

KenKen_SP · Answer

恐らくですが。。。Lnk ファイルのバイナリを読み込んで自力で
解析するしかないと思います。

エクセルＶＢＡでショートカットリンクの変更をするには

こんにちは。

こんばんは。

こんにちは。

この回答への補足

こんばんは。

この回答への補足

恐らくですが。

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング