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

2009/6/29 月曜日2012/8/30 木曜日

ファイルサーバを構築していると、サーバをリプレースする場合なんかに物凄く労力が必要になります。
システム的に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