ショートカットファイルの参照先を一括変更するスクリプト

ファイルサーバを構築していると、サーバをリプレースする場合なんかに物凄く労力が必要になります。
システム的にDFSを構成していればそれほどでも無いかも知れませんが、スタンドアローンのファイルサーバを移転しなくてはいけなくなった時なんかは、例えばユーザの既に作成しているショートカットのリンク先変更やらで、それはそれは物凄く手間です。

・・・というわけで、今回はショートカットを一括置換するスクリプトを作ってみました。
ただし、対応しているのは拡張子”.lnk”と”.url”のデータのみで、ワードやエクセルの中身のショートカットには利用出来ません。

使い方

以下のスクリプトをテキストに保存して、拡張子を”vbs”に変更して、スクリプト中のPRECEDENT_TARGET_UNCとNEW_TARGET_UNCの値を各自の環境に合わせてください。
あとは変更したいファイルをドラッグ&ドロップするだけです。

例えば”\\server01\share”を”\\server02\share”に書き換えたい場合は以下のように設定します。

Const PRECEDENT_TARGET_UNC = "\\server01"
Const NEW_TARGET_UNC       = "\\server02"

パスにはドライブ名を利用する事も出来ます。”\\server01\share”をVドライブにマウントする場合であれば、以下のように設定してください。

Const PRECEDENT_TARGET_UNC = "\\server01\share"
Const NEW_TARGET_UNC       = "V:"

また、書き換え時にバックアップを取ったりしませんので、実行する前にバックアップを必ずとって、一度テスト環境でテストしてください。

'* ショートカットの参照先を一括変更するスクリプト
'* https://pnpk.net/archives/2231
'* 
'* ■使い方
'* NEW_TARGET_UNCで指定した参照先にPRECEDENT_TARGET_UNCを書き換えるスクリプトです。
'* ファイルサーバ移行後にファイルサーバのUNCが変更になった場合、
'* 各クライアント上に残っているショートカットの参照先を変更するのが非常に面倒だったので作成しました。
'* 
'* このスクリプトをテキストファイルに保存し、拡張子を".vbs"に変更してください。
'* ショートカットファイルをドラッグ&ドロップで新しいUNCパスに変更します。
'* 一度に複数のファイルをドラッグ&ドロップで一括更新する事が可能ですが、あまり多いとエラーになります。
'* 
'* ■注意
'* このスクリプトは実行すると、ユーザの同意無しに対象ファイルのリンク先を変更します。
'* 実行前には必ずバックアップを取ってから実行してください。
'* 
'* 読みとり専用のファイルを指定した場合や、
'* 更新権限の無いファイルに対して操作を行うとエラーになります。
'* また、存在しないパスを入力すると処理が非常に遅くなります。
Option Explicit

'* -----------------設定ここから--------------------
'* PRECEDENT_TARGET_UNCに書き換えたい元のUNCパス、もしくはリンクを登録して、
'* NEW_TARGET_UNCに書き換えた後のUNCパス、もしくはリンクを登録します。
'* 対象ファイルは拡張子が".lnk"、もしくは".url"のファイルのみです。
'* 
'* 誤動作を極力回避させるために、先頭からのパス変更のみを一回だけ実行します。
'*  ※例えば"\\FileServer01\hogehoge\FileServer01"というパスに対して
'*   "FileServer01"を書き換える場合でも、あったとしても書き変わるのは最初の
'*   "FileServer01"だけです。
'* また、パスにはドライブ名も利用する事が出来ます。
Const PRECEDENT_TARGET_UNC = "\\FileServer01"
Const NEW_TARGET_UNC       = "\\FileServer02"

'* -----------------設定ここまで--------------------

Call Main()

Private Sub Main()
	Dim objFS
	'Dim strPATH 2012/08/30 コメントアウトしました
	Dim strFile
	
	Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
	'strPATH = objFS.GetParentFolderName(WScript.Arguments(0)) 2012/08/30 コメントアウトしました

	For Each strFile In WScript.Arguments
		'JAGDE_SHORTCUTの呼び出し
		If JAGDE_SHORTCUT(strFile) = True Then
			'REWRITE_SHORTCUTの呼び出し
			Call REWRITE_SHORTCUT(strFile)
		Else
			
		End If
	Next
	
	Wscript.Echo "ショートカット書き換え処理が完了しました。"
	
End Sub

'ショートカットかどうかの判定
Function JAGDE_SHORTCUT(strFile)
	If UCase(Right(strFile, 4)) = ".LNK" OR UCase(Right(strFile, 4)) = ".URL" Then
		JAGDE_SHORTCUT = True
	Else
		JAGDE_SHORTCUT = False
	End If
End Function

'ショートカットの書き換え
Function REWRITE_SHORTCUT(strFile)
	On Error Resume Next

	Dim WshShell
	Dim objShellLink
	Dim strSHORTCUT_PATH
	
	set WshShell = WScript.CreateObject("WScript.Shell")
	set objShellLink = WshShell.CreateShortcut(strFile)
	
	strSHORTCUT_PATH = objShellLink.TargetPath
	'先頭から文字列を評価しています。
	If UCase(Left(strSHORTCUT_PATH,Len(PRECEDENT_TARGET_UNC))) = UCase(PRECEDENT_TARGET_UNC) Then
		objShellLink.TargetPath = Replace(strSHORTCUT_PATH,PRECEDENT_TARGET_UNC,NEW_TARGET_UNC,1,1,1)
		objShellLink.Save
	End If
	'エラー処理
	If Err <> 0 Then
		If Err = -2147024891 Then
			WScript.Echo "エラーが発生しました。" & vbCrLf & vbCrLf &_
						 "以下のファイルに対する書き込み権限が不足しているため" & vbCrLf &_
						 "ファイルを更新する事が出来ませんでした。" & vbCrLf & vbCrLf &_
						 strFile & vbCrLf & vbCrLf &_
						 "ファイルのアクセス権限、または読み取り属性を確認してください。"& vbCrLf &_
						 "このファイルに対する処理はスキップします。"
		Else
			WScript.Echo Err.Number & " : " & Err.Description
		End If
	End If

	
End Function

10 COMMENTS

ぼっち情シス

pnpkさん
素晴らしいスクリプト作成ありがとうございます。
入替の時大変お世話になりました。
省略さん
あなたのコメントで私の環境でも使えました。
ありがとうございます。

省略

自己解決したエラーを報告いたします。
vbsの文字コードをUTF-8 → SJISにして保存しなおして解決しています。

UTF-8のまま実行した場合以下のエラーが発生しました。

行57 文字 53
終了していない文字列型の定数です。
800A0409

pnpk

>に さん
こんばんは、コメントいただきありがとうございます。

再度スクリプト見直しました。
おっしゃる通り、41行目と45行目のstrPATHの部分、利用しておりませんでした。

取り急ぎ問題のある行に関してはコメントアウトしました。

去年いただいた せき さんにも申し訳無い事をしました。

ご指摘いただきありがとうございました。

よろしくお願いします。

pnpk

>せき さん
こんばんは、コメントありがとうございます。

上記スクリプト、ショートカットをドラッグ&ドロップして動作させる事を想定して作ったので、そのままダブルクリックで実行すると引き数が無いのでエラーになります。

ダブルクリックでスクリプトを実行されていた場合、スクリプトにドラッグ&ドロップでファイルを投げ入れて動作するか確認ください。この動作でエラーが出る場合、ショートカットを保存しているフォルダパスやファイル名に問題があるかもしれません。

45行目はドラッグ&ドロップするファイルのパス情報を取得する部分なので、引き数としてファイルパスが正しくスクリプト側に伝わっていない事が考えられます。

根本的な対策では無いですが、一度動作ご確認いただければと思います。

よろしくお願いします。

d.i

ものすごく簡単にショートカットの変更ができました。
スクリプトの形なのでやり方もわかり、他にも応用が利きそうです。
大変勉強になりました。ありがとうございます。

ituki

助かりました。
自分は以下の分を追加して使用しました。

objShellLink.WorkingDirectory=Replace(strSHORTCUT_PATH,PRECEDENT_TARGET_UNC,NEW_TARGET_UNC,1,1,1)

pnpk

>komikoniさん
コメントありがとうございます。
ちょうど去年の今頃に作ったVBスクリプトです。
お役に立てたようでよかったです。

komikoni

公開ありがとうございます。超便利ですね。
こういうフリーソフトあるかなと思って探して無かったので
VBSで書くしかないかなと思ってたところでした。
急いでたので助かりました~

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です