[VBS]ショートカットファイルの検索
ショートカットファイルを検索し、
参照先を記録する。
リンクが切れていないか調査のために使用してみては？
Option Explicit
'**************************************************************************************************
' 定数宣言
'**************************************************************************************************
Const LOG_FILE_PREFIX = "SearchShortCutFile_vbs_"
Const SHORTCUT_EXT = "lnk"
' ショートカットリンク先判定ステータス
Const SHORTCUT_STATUS_FILE = "ファイル"
Const SHORTCUT_STATUS_FOLDER = "フォルダ"
Const SHORTCUT_STATUS_WORKINGDIR_ONLY = "作業ディレクトリのみ" ' TargetPathがなくWorkingDirectoryのみが有効な場合
Const SHORTCUT_STATUS_BROKEN = "リンク切れ"
' 取得時のエラータイプ
Const SHORTCUT_ERROR_CREATE_OBJECT = "オブジェクト作成エラー" ' WshShortcutオブジェクトの作成失敗
Const SHORTCUT_ERROR_GET_TARGETPATH = "ターゲットパス取得エラー" ' TargetPath取得失敗
Const SHORTCUT_ERROR_GET_WORKINGDIR = "作業ディレクトリ取得エラー" ' WorkingDirectory取得失敗
Const SHORTCUT_ERROR_UNKNOWN = "不明なエラー" ' その他の取得失敗
' ログファイルヘッダー
Const LOG_HEADER = "No." & vbTab & _
"リンク先判定" & vbTab & _
"最終更新日時" & vbTab & _
"ファイルサイズ(バイト)" & vbTab & _
"ファイル名" & vbTab & _
"フォルダパス" & vbTab & _
"ショートカットリンク先パス" & vbTab & _
"エラー詳細"
' FileSystemObjectのOpenFileメソッド用モード定数
Const FSO_APPENDING = 8 ' テキストファイルへの追記モード
' FileSystemObjectのOpenFileメソッド用フォーマット定数 (TRISTATE_UNICODEを推奨)
Const TRISTATE_UNICODE = -1 ' Unicode (日本語環境での文字化け防止のため推奨)
'**************************************************************************************************
' メイン処理のエントリーポイント
'**************************************************************************************************
Call Main
'**************************************************************************************************
' Mainサブルーチン
' 機能: スクリプトの主要な処理フローを制御します。
' ショートカットファイルの検索、ログへの出力、処理時間の表示を行います。
' 引数: なし
' 戻り値: なし
' 備考: このスクリプトが置かれたフォルダ配下を対象とします。
' ログファイルも、このスクリプトと同じフォルダに作成されます。
'**************************************************************************************************
Sub Main()
' ローカル変数としてオブジェクトを宣言
Dim fso As Object
Dim wsh As Object
Dim intRecordCount As Long ' 処理されたショートカットファイルのカウント
Dim dteStartTime As Date ' 処理開始時刻
Dim dteEndTime As Date ' 処理終了時刻
Dim strLogFilePath As String ' ログファイルのフルパス
Dim objRootFolder As Object
' オブジェクトの初期化
Set fso = CreateObject("Scripting.FileSystemObject")
Set wsh = CreateObject("WScript.Shell")
' 処理開始時刻の記録
dteStartTime = Now()
' ショートカットファイル数の初期化
intRecordCount = 0
' ログファイルパスを生成
strLogFilePath = fso.BuildPath(fso.GetParentFolderName(WScript.ScriptFullName), _
LOG_FILE_PREFIX & wsh.ComputerName & "_" & _
FormatDateForLog(Now()) & ".log")
' ログファイルのヘッダーを書き込みます。
Call F_LogWrite(fso, strLogFilePath, "処理開始: " & FormatDateTime(dteStartTime, vbGeneralDate) & vbCrLf & LOG_HEADER)
' 現在のスクリプトがあるフォルダの取得
On Error Resume Next ' GetFolderでエラーが発生する可能性に備える
Set objRootFolder = fso.GetFolder(fso.GetParentFolderName(WScript.ScriptFullName))
If Err.Number <> 0 Then
' エラー発生時はログに記録し、ユーザーに通知して終了
Call F_LogWrite(fso, strLogFilePath, "エラー: スクリプト実行フォルダの取得に失敗しました。パス: '" & fso.GetParentFolderName(WScript.ScriptFullName) & _
"', エラーコード: " & Err.Number & ", エラー詳細: " & Err.Description)
WScript.Echo "重大なエラー: スクリプト実行フォルダの取得に失敗しました。スクリプトを終了します。"
WScript.Quit 1
End If
On Error GoTo 0 ' エラーハンドリングを元に戻す
' ショートカットファイルの検索と処理を開始
Call F_FindShortcutsInFolder(objRootFolder, fso, wsh, intRecordCount, strLogFilePath)
' 処理終了時刻の記録
dteEndTime = Now()
' 処理時間の計算と整形
Dim strDuration As String
strDuration = F_FormatDuration(dteStartTime, dteEndTime)
' ログファイルに処理終了情報と処理時間を書き込みます。
Call F_LogWrite(fso, strLogFilePath, "処理終了: " & FormatDateTime(dteEndTime, vbGeneralDate) & vbTab & _
"処理時間: " & strDuration & vbCrLf & _
"処理件数: " & intRecordCount)
' オブジェクトの解放
Set fso = Nothing
Set wsh = Nothing
' 処理結果をユーザーに通知
WScript.Echo "処理が完了しました！" & vbCrLf & _
"開始時刻: " & FormatDateTime(dteStartTime, vbGeneralDate) & vbCrLf & _
"終了時刻: " & FormatDateTime(dteEndTime, vbGeneralDate) & vbCrLf & _
"処理時間: " & strDuration & vbCrLf & _
"処理件数: " & intRecordCount & vbCrLf & _
"ログファイル: " & strLogFilePath
End Sub
'**************************************************************************************************
' F_FindShortcutsInFolderサブルーチン
' 機能: 指定されたフォルダとそのサブフォルダ内のショートカットファイルを再帰的に検索し、
' その情報をログに出力します。
' 引数: objCurrentFolder (Object) - 検索対象のフォルダオブジェクト
' fso (Object) - FileSystemObjectのインスタンス
' wsh (Object) - WshShellオブジェクトのインスタンス
' intRecordCount (Long) - 処理されたショートカットファイルのカウント (ByRefで更新)
' strLogFilePath (String) - ログファイルのパス
' 戻り値: なし
'**************************************************************************************************
Function F_FindShortcutsInFolder(ByVal objCurrentFolder As Object, _
ByVal fso As Object, _
ByVal wsh As Object, _
ByRef intRecordCount As Long, _
ByVal strLogFilePath As String)
Dim objFile As Object ' ファイルを格納する変数
Dim objSubFolder As Object ' サブフォルダを格納する変数
' 現在のフォルダ内のファイルを処理します。
For Each objFile In objCurrentFolder.Files
If LCase(fso.GetExtensionName(objFile.Name)) = SHORTCUT_EXT Then
intRecordCount = intRecordCount + 1
' ショートカットファイルの処理を別関数に委譲 (必要なオブジェクトとカウンタを渡す)
Call F_ProcessShortcutFile(objFile, fso, wsh, intRecordCount, strLogFilePath)
End If
Next
' 現在のフォルダ内のサブフォルダを再帰的に処理します。
For Each objSubFolder In objCurrentFolder.SubFolders
On Error Resume Next ' サブフォルダアクセス中にエラーが発生する可能性に備える
' 再帰呼び出し (必要なオブジェクトとカウンタを渡す)
Call F_FindShortcutsInFolder(objSubFolder, fso, wsh, intRecordCount, strLogFilePath)
If Err.Number <> 0 Then
' エラー発生時はログに記録し、エラーをクリアして続行
Call F_LogWrite(fso, strLogFilePath, FormatDateTime(Now(), vbGeneralDate) & vbTab & _
"エラー: サブフォルダアクセス中にエラー発生。パス: '" & objSubFolder.Path & _
"', エラーコード: " & Err.Number & ", エラー詳細: " & Err.Description)
Err.Clear ' エラーをクリアして次のサブフォルダの処理を続行
End If
On Error GoTo 0 ' エラーハンドリングを元に戻す
Next
End Function
'**************************************************************************************************
' F_ProcessShortcutFileサブルーチン
' 機能: 個々のショートカットファイルの詳細情報を取得し、ログに出力します。
' 引数: objShortcutFile (Object) - ショートカットファイルのファイルオブジェクト
' fso (Object) - FileSystemObjectのインスタンス
' wsh (Object) - WshShellオブジェクトのインスタンス
' intRecordCount (Long) - 処理されたショートカットファイルのカウント (ログ出力用)
' strLogFilePath (String) - ログファイルのパス
' 戻り値: なし
'**************************************************************************************************
Function F_ProcessShortcutFile(ByVal objShortcutFile As Object, _
ByVal fso As Object, _
ByVal wsh As Object, _
ByVal intRecordCount As Long, _
ByVal strLogFilePath As String)
Dim objShortcut As Object ' WshShortcutオブジェクト
Dim strShortcutTargetPath As String ' ショートカットのリンク先パス
Dim strLinkStatus As String ' リンク先の状態（ファイル、フォルダ、リンク切れ、エラーなど）
Dim strErrorDetail As String ' エラー詳細メッセージ
strShortcutTargetPath = ""
strLinkStatus = ""
strErrorDetail = ""
On Error Resume Next ' ショートカットオブジェクト作成中のエラーを捕捉
Set objShortcut = wsh.CreateShortcut(objShortcutFile.Path)
If Err.Number <> 0 Then
strLinkStatus = SHORTCUT_ERROR_CREATE_OBJECT
strErrorDetail = "WshShortcutオブジェクトの作成に失敗しました: " & Err.Description
Err.Clear
Else
' TargetPathの取得を試みる
Dim tempTargetPath As String
On Error Resume Next ' TargetPath取得中のエラーを捕捉
tempTargetPath = objShortcut.TargetPath
If Err.Number <> 0 Then
strLinkStatus = SHORTCUT_ERROR_GET_TARGETPATH
strErrorDetail = "TargetPathの取得に失敗しました: " & Err.Description
Err.Clear
Else
strShortcutTargetPath = tempTargetPath
End If
On Error GoTo 0 ' エラーハンドリングを元に戻す
' TargetPathが空の場合、WorkingDirectoryを試す
If strShortcutTargetPath = "" Then
Dim tempWorkingDir As String
On Error Resume Next ' WorkingDirectory取得中のエラーを捕捉
tempWorkingDir = objShortcut.WorkingDirectory
If Err.Number <> 0 Then
If strLinkStatus = "" Then ' TargetPath取得エラーでなければ
strLinkStatus = SHORTCUT_ERROR_GET_WORKINGDIR
End If
strErrorDetail = strErrorDetail & IIf(strErrorDetail = "", "", " / ") & "WorkingDirectoryの取得に失敗しました: " & Err.Description
Err.Clear
Else
If tempWorkingDir <> "" Then
strShortcutTargetPath = tempWorkingDir ' 作業ディレクトリをリンク先として記録
If strLinkStatus = "" Then ' エラーがまだ記録されていなければ
strLinkStatus = SHORTCUT_STATUS_WORKINGDIR_ONLY
End If
End If
End If
On Error GoTo 0 ' エラーハンドリングを元に戻す
End If
' 取得したパスに基づいてリンク先を判定 (エラーが発生していない場合のみ)
If strLinkStatus = "" Then
If fso.FileExists(strShortcutTargetPath) Then
strLinkStatus = SHORTCUT_STATUS_FILE
ElseIf fso.FolderExists(strShortcutTargetPath) Then
strLinkStatus = SHORTCUT_STATUS_FOLDER
ElseIf strShortcutTargetPath = "" Then ' TargetPathもWorkingDirectoryも空の場合
strLinkStatus = SHORTCUT_ERROR_UNKNOWN
strErrorDetail = "TargetPathもWorkingDirectoryも取得できませんでした。"
Else
strLinkStatus = SHORTCUT_STATUS_BROKEN
End If
End If
End If
' オブジェクトの解放
Set objShortcut = Nothing
' ログに出力する情報を整形します。
Dim strLogLine As String
strLogLine = Right("0000" & intRecordCount, 4) & vbTab & _
strLinkStatus & vbTab & _
FormatDateTime(objShortcutFile.DateLastModified, vbGeneralDate) & vbTab & _
objShortcutFile.Size & vbTab & _
objShortcutFile.Name & vbTab & _
objShortcutFile.ParentFolder & vbTab & _
strShortcutTargetPath & vbTab & _
strErrorDetail ' エラー詳細もログに出力
Call F_LogWrite(fso, strLogFilePath, strLogLine)
End Function
'**************************************************************************************************
' F_LogWriteサブルーチン
' 機能: 指定されたデータをログファイルに書き込みます。
' 引数: fso (Object) - FileSystemObjectのインスタンス
' strLogFilePath (String) - ログファイルのフルパス
' strData (String) - ログに書き込む文字列
' 戻り値: なし
' 備考: ログファイルが存在しない場合は新規作成し、存在する場合は追記します。
'**************************************************************************************************
Function F_LogWrite(ByVal fso As Object, ByVal strLogFilePath As String, ByVal strData As String)
Dim objFile As Object ' TextStreamオブジェクト
On Error Resume Next ' ファイルオープン中のエラーを捕捉
' ログファイルを開きます。新規作成 (True) および Unicode (TRISTATE_UNICODE) を指定
Set objFile = fso.OpenTextFile(strLogFilePath, FSO_APPENDING, True, TRISTATE_UNICODE)
If Err.Number <> 0 Then
' ログファイルへの書き込み自体に失敗した場合の最終手段
WScript.Echo "重大なエラー: ログファイルのオープンまたは書き込み中に問題が発生しました。" & vbCrLf & _
"エラーコード: " & Err.Number & ", エラー詳細: " & Err.Description & vbCrLf & _
"ログファイルパス: " & strLogFilePath & vbCrLf & _
"書き込みを試みたデータ: " & strData
WScript.Quit 1 ' スクリプトをエラー終了
Else
objFile.WriteLine (strData)
End If
objFile.Close
Set objFile = Nothing
On Error GoTo 0 ' エラーハンドリングを元に戻す
End Function
'**************************************************************************************************
' F_FormatDuration関数
' 機能: 開始時刻と終了時刻から処理時間を整形して返します。
' 引数: dteStart (Date) - 処理開始時刻
' dteEnd (Date) - 処理終了時刻
' 戻り値: String - 整形された処理時間文字列
'**************************************************************************************************
Function F_FormatDuration(ByVal dteStart As Date, ByVal dteEnd As Date) As String
Dim lngTotalSeconds As Long
lngTotalSeconds = DateDiff("s", dteStart, dteEnd)
Dim strDuration As String
If lngTotalSeconds < 60 Then
strDuration = lngTotalSeconds & "秒"
ElseIf lngTotalSeconds < 3600 Then
strDuration = Int(lngTotalSeconds / 60) & "分" & (lngTotalSeconds Mod 60) & "秒"
Else
strDuration = Int(lngTotalSeconds / 3600) & "時間" & _
Int((lngTotalSeconds Mod 3600) / 60) & "分" & _
(lngTotalSeconds Mod 60) & "秒"
End If
F_FormatDuration = strDuration
End Function
'**************************************************************************************************
' FormatDateForLog関数
' 機能: 日付をYYYYMMDD形式の文字列に整形して返します。
' 引数: dteDate (Date) - 整形する日付
' 戻り値: String - YYYYMMDD形式の文字列
'**************************************************************************************************
Function FormatDateForLog(ByVal dteDate As Date) As String
FormatDateForLog = Year(dteDate) & Right("0" & Month(dteDate), 2) & Right("0" & Day(dteDate), 2)
End Function
スクリプトの実行方法
このスクリプトは、元のスクリプトと同様にVBScriptとして実行できます。
* 上記のコードを SearchShortcut.vbs のような名前でファイルに保存します。
* このファイルをダブルクリックするか、コマンドプロンプトで cscript SearchShortcut.vbs を実行します。
スクリプトが実行されたフォルダに、SearchShortCutFile_vbs_コンピュータ名_YYYYMMDD.log という形式のログファイルが作成されます。
