リンク切れのショートカットファイルを探索する VBScript

• 【VBS】リンク切れのショートカットファイルを検索 - プログラムのWIKI

上のサイトにコードがある。大変有用で参考になるので、サイトが消えては困ると思い、以下に引用させていただく。

' explolerのお気に入り情報のリンク切れ確認ツール
' ショートカットの元ファイル／元フォルダーが存在しないとき、
' 情報を表示します。
Option Explicit

' 対象は「お気に入り」フォルダー
const favoritesF = objWshShell.SpecialFolders("FAVORITES")

Dim objWShell
Set objWShell = CreateObject("WScript.Shell")
Dim objSCut
Dim objFS, objFolder
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(favoritesF)

FindDeadLinkShortcut objFolder
Set objFolder = Nothing
Set objFS = Nothing

WScript.Quit
' -------------------------------------------------------------------------------
Sub FindDeadLinkShortcut(objFolder)
    Dim objFile, objSubFolder
    dim chKekkaText
    For Each objFile In objFolder.Files
         if objFile.type = "ショートカット" then
              Set objSCut = objWShell.CreateShortcut(objFile)
              If objFS.FolderExists(objSCut.TargetPath) = true Then
              else
                 if objFS.FileExists(objSCut.TargetPath) = true Then
                 else
                  WScript.Echo "■" & objFolder.name & "," & objFile.Name & "," & objSCut.TargetPath
                 end if
              end if
              Set objSCut = Nothing
         end if
    Next
' 再帰処理をします。
    For Each objSubFolder In objFolder.SubFolders
        FindDeadLinkShortcut objSubFolder
    Next
End Sub

• VBScript でプログレスバー的なモノを作りたい

上の記事で作ったような、IE 窓に進捗を表示する処理を組み込んだりすれば、もっと使いやすくなるかも。

ちょっと手直ししてみた。

Option Explicit

' 探索を始めるルートパス
Const PATH = "C:\Test\"

Dim shell  : Set shell  = CreateObject("WScript.Shell")
Dim fso    : Set fso    = CreateObject("Scripting.FileSystemObject")
Dim folder : Set folder = fso.GetFolder(PATH)

FindDeadLinkShortcut folder

Set folder = Nothing
Set fso = Nothing
WScript.Quit

Sub FindDeadLinkShortcut(folder)
  Dim file
  For Each file In folder.Files
    If file.Type = "ショートカット" Then
      Dim shortcut : Set shortcut = shell.CreateShortcut(file)
      If fso.FolderExists(shortcut.TargetPath) = False And fso.FileExists(shortcut.TargetPath) = False Then
        WScript.Echo folder.Name & " : " & file.Name & " : " & shortcut.TargetPath
      End If
      Set shortcut = Nothing
    End If
  Next
  
  ' 再帰処理
  Dim subFolder
  For Each subFolder In folder.SubFolders
    FindDeadLinkShortcut subFolder
  Next
End Sub

• 上のコードでいうと、Dim file の手前で folder.Name を見て、探索したくないフォルダは無視する、みたいなこともできる。
• folder.SubFolders.Count でサブフォルダの数が分かるので、フォルダ数が多すぎる階層はチェックしない、とかもできる。

再帰処理イイネェ～