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

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

そこで、

history2url.vbs

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

Set re=New RegExp
re.Pattern="[\x00-\x31\x7F-\xFF]"
re.Global=True
re.MultiLine=True
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=re.Replace(Title,"")
      Text="[InternetShortcut]" & vbCrLf & _
        "URL=" & Url & vbCrLf & _
        "[{5CBF2787-48CF-4208-B90E-EE5E5D420294}]" & vbCrLf & _
        "Prop23=64," & Replace(LastVisited," ",":") & ":00.000" & vbCrLf  & _
        "Prop21=31," & Title & vbCrLf
      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,"&","")
      Title=Replace(Title,".","_")
      LastVisited=Replace(LastVisited,"/","-")
      LastVisited=Replace(LastVisited,":","-")
      Path=LastVisited & " " & Title & ".url"
      If fso.FileExists(Path) Then
      Else
        On Error Resume Next
        fso.CreateTextFile(Left(Path,200),,True).Write Text
        If Err Then
          MsgBox Join(Array(Path,Escape(Path),Err.Description),vbCrLf)
          WScript.Quit
        End If
        On Error GoTo 0
      End If
    Next
  Next
Next

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

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

タイトルをファイル名に使うと、ファイル名に使えない文字が変換されるので、タイトルを説明カラムに入れます。

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