2017年9月
          1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29 30
無料ブログはココログ

« IE9の「お気に入りバー」を折りたたむ。 | トップページ | 「お気に入り」のメニュー順を設定する。(その1) »

2011年5月25日 (水)

履歴のすべてをインターネットショートカットに変換する。

個々の履歴をお気に入りに追加したり、コピー貼り付けでインターネットショートカットに変えることはできますが、最終表示日は保存されません。

そこで、

history2url.vbs

Option Explicit
Dim fso
Dim Week
Dim Site
Dim Folder
Dim FolderItem
Dim Url
Dim LastVisited
Dim Path
Dim Title
Dim k
Dim Text

Set fso=CreateObject("Scripting.FileSystemObject")
For Each Week In CreateObject("Shell.Application").NameSpace(34).Items
  For Each Site In Week.GetFolder.Items
    Set Folder=Site.GetFolder
    For Each FolderItem In Folder.Items
      URL=Folder.GetDetailsOf(FolderItem,0)
      Title=Folder.GetDetailsOf(FolderItem,1)
      LastVisited=Folder.GetDetailsOf(FolderItem,2)
      Title=Replace(Title,":","")
      Title=Replace(Title,"\","")
      Title=Replace(Title,"/","-")
      Title=Replace(Title,"*","")
      Title=Replace(Title,"?","")
      Title=Replace(Title,"""","")
      Title=Replace(Title,"<","")
      Title=Replace(Title,">","")
      Title=Replace(Title,"|","")
      Title=Replace(Title,".","_")
      Path=Title & ".url"
      Text="[InternetShortcut]" & vbCrLf & _
        "URL=" & Url & vbCrLf & _
        "[{5CBF2787-48CF-4208-B90E-EE5E5D420294}]" & vbCrLf & _
        "Prop23=64," & Replace(LastVisited," ",":") & ":00.000" & vbCrLf
      For k=1 To 100
        If fso.FileExists(Path) Then
           If fso.OpenTextFile(Path).ReadAll=Text Then Exit For
        Else
          fso.CreateTextFile(Path).Write Text
          Exit For
        End If
        Path=Title & " " & k & ".url"
      Next
    Next
  Next
Next

カレントディレクトリに作成するので、作成先フォルダで実行するか、ショートカットを作って作業フォルダを指定して実行します。

同じ履歴を重複して作成しないようにしているので、差分だけが追加されます。

URLカラムと最終表示日カラムを表示すれば、履歴フォルダと同等になります。

« IE9の「お気に入りバー」を折りたたむ。 | トップページ | 「お気に入り」のメニュー順を設定する。(その1) »