Corredor

ウェブ、プログラミングの勉強メモ。

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

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

'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

neos21.hatenablog.com

上記の記事で作ったような、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 でサブフォルダの数が分かるので、フォルダ数が多すぎる階層はチェックしない、とかもできる。

再帰処理イイネェ~

最速攻略 VBScriptサンプル大全集

最速攻略 VBScriptサンプル大全集