プログラミング

プログラミングに関するフォーラムです。VBAは除きます。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 7 Professional : 指定なし)
フォルダー内のURLショートカット群を一覧表示したい
投稿日時: 19/10/21 15:07:53
投稿者: ぼん

以前、このコミュニティで質問し表題のコードを5年前位に教えていただいた
のですが、ハードディスクがクラッシュしてしまいました。
 
言語はVBSで、ダブルクリックすると、メモ帳にタイトルとURLが羅列さ
れるというものでした。
数十個入っていようが、一瞬で一覧表示される感動的なものでした。
 
プログラムの行数は、20行くらいでした。
 
検索しても出てこないので、消されたのだと思います。
 
バックアップを取っていなかったことを反省しています。
もう一度、ご教示頂けないでしょうか。
宜しくお願い致します。

回答
投稿日時: 19/11/14 14:41:08
投稿者: sk

引用:
フォルダー内のURLショートカット群を一覧表示したい

引用:
言語はVBSで、ダブルクリックすると、メモ帳にタイトルとURLが
羅列されるというものでした。

Dim wsh, fso, ts
Dim strFavorites, strDesktop, strTextFilePath
 
Set wsh = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
 
strFavorites = wsh.SpecialFolders("Favorites")
strDesktop = wsh.SpecialFolders("Desktop")
strTextFilePath = strDesktop & "\FavoritesList.txt"
 
Set ts = fso.CreateTextFile(strTextFilePath, True, True)
ts.WriteLine "フォルダパス" & vbTab & "ショートカットファイル名" & vbTab & "URL"
ts.Close
Set ts = Nothing
 
Call WriteListOfURLShortcuts(strFavorites, strTextFilePath)
 
wsh.Run "notepad.exe """ & strTextFilePath & """"
 
Set fso = Nothing
Set wsh = Nothing
 
Function WriteListOfURLShortcuts(FolderPath, OutputTextFilePath)
 
    Dim fso, fol, sfol, fl, ts
 
    Set fso = CreateObject("Scripting.FileSystemObject")
 
    If fso.FolderExists(FolderPath) = False Then
        Exit Function
    End If
 
    Set fol = fso.GetFolder(FolderPath)
 
    For Each sfol In fol.SubFolders
        Call WriteListOfURLShortcuts(sfol.Path, OutputTextFilePath)
    Next
 
    For Each fl In fol.Files
        If fso.GetExtensionName(fl.Path) = "url" Then
            Set ts = fso.OpenTextFile(OutputTextFilePath, 8, True, -1)
            ts.WriteLine fol.Path & vbTab & fl.Name & vbTab & GetURLShortcutTargetPath(fl.Path)
            ts.Close
            Set ts = Nothing
        End If
    Next
 
    Set fol = Nothing
    Set fso = Nothing
 
End Function
 
Function GetURLShortcutTargetPath(FilePath)
 
    Dim wsh, urlsc
 
    Set wsh = CreateObject("WScript.Shell")
    Set urlsc = wsh.CreateShortcut(FilePath)
    GetURLShortcutTargetPath = urlsc.TargetPath
    Set urlsc = Nothing
    Set wsh = Nothing
 
End Function
 
引用:
プログラムの行数は、20行くらいでした。

当時の要件定義やコードの内容については不明ですが、
以上のような感じでしょうか。

トピックに返信