Exportieren von Firefox-Lesezeichen als separate .URLs unter Beibehaltung der Zeitstempel

Creating .URL files while preserving timestamp from any browser bookmarks.html

This VBA macro lets you convert a standard bookmarks.html file (Firefox, Chrome, Opera) to multiple .URL files (Internet Explorer)

As a bonus, it reads out the create date from your bookmarks and modifies the new .URL files to reflect that date in your Windows Explorer. It also preserves your folder and subfolder structure. Have a look at the screenshot

Usage

• start your desired browser and export your bookmarks as HTML file.
  Every major browser supports this ability.
• download & open your corresponding version
  • create_URL_files.xls
• Use that beautiful start button
• Excel asks for the path to your HTML file which you created in the first step
• all new shortcut files are stored in a new folder at the same place as your HTML file
• file create and file modified date are changed to their corresponding date when you first created the bookmark in your browser

How it works

• a VBA macro opens your HTML file as pure text in unicode (special characters are preserved)
• it searches line by line for "HREF=" and extracts the URL
• it does the same for the date added and for the used bookmark title in your browser
• it creates all subfolders according to your bookmarks structure
• it creates a new text file for each bookmark and saves the following data into that file

  [InternetShortcut] URL=http://www.someaddress.com/ 

• the file is saved as <bookmarktitle>.url
• the title is truncated to max 100 characters and all forbidden characters are removed
• it checks if a shortcut already exists and if yes, it appends the create date
• the given UNIX date is converted into a readable format
• the file creation and file modified timestamps are changed to the date, when you saved the bookmark in your browser

Helpful links

• Explains syntax of internet shortcut files
• Teached me how to modify file timestamps
• Online converter for UNIX timestamps
• Teached me how to deal with Unicode in filenames and titles
• Showing me a trick to get the Windows function CreateFileW working
  (that is a windows kernel32 method to create files with a unicode filename)
• Solved a compatibility issue between Office 2003 and Office 2013

If you just want to create shortcut files from any browser without preserving the timestamps, than this is the easy way

1. Export your bookmarks as HTML file.
   Internet Explorer, Firefox, Chrome and Opera have this ability build in
2. TypeWin+R and enter %USERPROFILE%\Favorites
3. Temporary backup the whole content somewhere
4. Open Internet Explorer → File → Import & Export
5. Select your HTML file and import them
6. TypeWin+R and enter %USERPROFILE%\Favorites again

Now you have all bookmarks as plain .URL files. You can move them where ever you want.
Internet Explorer doesn't store bookmarks the same way other browsers do (in a single file). He just creates .URL files for every bookmark in the favorites folder.

Note: Remember to delete the new IE favorites and restore them with your backup

Hier ist der Code von nixda für 2013, der korrigiert wurde, um ein paar Tippfehler zu korrigieren und das letzte Änderungsdatum zu entfernen, das nicht in derselben Zeile wie der Hyperlink in einer exportierten HTML-Datei von Google Chrome gefunden wurde.

Das folgende Schaltfläche-Klick-Skript wurde geändert, um den zuletzt geänderten Codeteil auszukommentieren.

Private Sub CommandButton1_Click() Dim shortcutfile As String Dim myadddate As Double forbidden = Array("\", "/", ":", "*", "?", """", "<", ">", "|", "&quot;", "&amp;", "&#39;")  Application.ScreenUpdating = False ChDir ThisWorkbook.Path myfullfilename = Application.GetOpenFilename(fileFilter:="HTML Files, *.html")  If myfullfilename = False Then Exit Sub mypath = Left$(myfullfilename, InStrRev(myfullfilename, "\")) & "InternetShortCuts" & " " & Format(Now, "yyyy.mm.dd hh-mm-ss") Workbooks.OpenText FileName:=myfullfilename, Origin:=-535, DataType:=xlDelimited, Tab:=False, semicolon:=False, comma:=False, Space:=False  On Error Resume Next MkDir mypath On Error GoTo 0  Set mysheet = ActiveWorkbook.Sheets(1) With mysheet For i = 1 To .UsedRange.SpecialCells(xlCellTypeLastCell).Row  If InStr(UCase(.Cells(i, 1)), "<DT><H3 ADD_DATE=") <> 0 Then folderend = InStrRev(.Cells(i, 1), "<") folderstart = InStrRev(.Cells(i, 1), ">", folderend) newfolder = Mid(.Cells(i, 1), folderstart + 1, folderend - folderstart - 1)  For j = 0 To UBound(forbidden) newfolder = Replace(newfolder, forbidden(j), "") Next j  mypath = mypath & "\" & newfolder  On Error Resume Next MkDir mypath On Error GoTo 0 End If  If InStr(UCase(.Cells(i, 1)), "</DL><P>") <> 0 Then mypath = Left(mypath, InStrRev(mypath, "\") - 1) End If  If InStr(UCase(.Cells(i, 1)), "HREF=") <> 0 Then urlstart = InStr(.Cells(i, 1), "HREF=") urlend = InStr(.Cells(i, 1), "ADD_DATE=") myurl = Mid(.Cells(i, 1), urlstart + 6, urlend - urlstart - 8)  'adddateend = InStr(.Cells(i, 1), "LAST_") 'myadddate = Mid(.Cells(i, 1), urlend + 10, adddateend - urlend - 12) 'myadddate = DateAdd("s", myadddate, DateSerial(1970, 1, 1))  titleend = InStrRev(.Cells(i, 1), "<") titlestart = InStrRev(.Cells(i, 1), ">", titleend) mytitle = Mid(.Cells(i, 1), titlestart + 1, titleend - titlestart - 1) mytitle = Left(mytitle, 100)  For j = 0 To UBound(forbidden) mytitle = Replace(mytitle, forbidden(j), "") Next j  shortcutfile = mypath & "\" & Trim(mytitle) & ".url"  With CreateObject("Scripting.FileSystemObject") 'If .FileExists(shortcutfile) Then shortcutfile = mypath & "\" & Trim(mytitle) & " " & Format(myadddate, "yyyy.mm.dd hh-mm-ss") & ".url" If .FileExists(shortcutfile) Then shortcutfile = mypath & "\" & Trim(mytitle) & " " & ".url" With .CreateTextFile(shortcutfile,, True) .write "[InternetShortcut]" & vbNewLine .write "URL=" & myurl .Close End With End With  Call Settimestamp(shortcutfile, myadddate)  End If Next i  Close .Parent.Close False  End With  Application.ScreenUpdating = True End Sub 

Das folgende change_timestamp-Modul wurde geändert, um einen Tippfehler zu korrigieren, wenn die CreateFileW-Funktion deklariert wurde, wobei lpFileName als LongLong anstelle von Long unter # VBA7-Abschnitt und Zeilenfortsetzung deklariert wurde, wenn die CreateFileW-Funktion im #Else-Abschnitt deklariert wurde.

Option Explicit  Private Const OPEN_EXISTING = &H3 Private Const FILE_SHARE_READ = &H1 Private Const FILE_SHARE_WRITE = &H2 Private Const GENERIC_WRITE = &H40000000  Public Type FileTime dwLowDateTime As Long dwHighDateTime As Long End Type  Public Type SYSTEMTIME wYear As Integer wMonth As Integer wDayOfWeek As Integer wDay As Integer wHour As Integer wMinute As Integer wSecond As Integer wMilliseconds As Integer End Type  #If VBA7 Then Private Declare PtrSafe Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FileTime, lpFileTime As FileTime) As Long Private Declare PtrSafe Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FileTime) As Long Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long  Private Declare PtrSafe Function CreateFileW Lib "kernel32.dll" _ (ByVal lpFileName As Long, _ ByVal dwDesiredAccess As Long, _ ByVal dwShareMode As Long, _ ByVal lpSecurityAttributes As Long, _ ByVal dwCreationDisposition As Long, _ ByVal dwFlagsAndAttributes As Long, _ ByVal hTemplateFile As Long) As Long  Private Declare PtrSafe Function SetFileTimeCreate Lib "kernel32" Alias "SetFileTime" _ (ByVal hFile As Long, _ CreateTime As FileTime, _ ByVal LastAccessTime As Long, _ LastModified As FileTime) As Long #Else Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FileTime, lpFileTime As FileTime) As Long Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FileTime) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long  Private Declare Function CreateFileW Lib "kernel32.dll" _ (ByVal lpFileName As Long, _ ByVal dwDesiredAccess As Long, _ ByVal dwShareMode As Long, _ ByVal lpSecurityAttributes As Long, _ ByVal dwCreationDisposition As Long, _ ByVal dwFlagsAndAttributes As Long, _ ByVal hTemplateFile As Long) As Long  Private Declare Function SetFileTimeCreate Lib "kernel32" Alias "SetFileTime" _ (ByVal hFile As Long, _ CreateTime As FileTime, _ ByVal LastAccessTime As Long, _ LastModified As FileTime) As Long #End If  '======================================================================================================================= '======================================================================================================================= '=======================================================================================================================  Function Settimestamp(FileName, FileDateTime)  Dim FileHandle As Long Dim Res As Long Dim ErrNum As Long Dim ErrText As String Dim tFileTime As FileTime Dim tLocalTime As FileTime Dim tSystemTime As SYSTEMTIME  With tSystemTime .wYear = Year(FileDateTime) .wMonth = Month(FileDateTime) .wDay = Day(FileDateTime) .wDayOfWeek = Weekday(FileDateTime) - 1 .wHour = Hour(FileDateTime) .wMinute = Minute(FileDateTime) .wSecond = Second(FileDateTime) End With  Res = SystemTimeToFileTime(lpSystemTime:=tSystemTime, lpFileTime:=tLocalTime) Res = LocalFileTimeToFileTime(lpLocalFileTime:=tLocalTime, lpFileTime:=tFileTime)  FileHandle = CreateFileW(lpFileName:=StrPtr(FileName), _ dwDesiredAccess:=GENERIC_WRITE, _ dwShareMode:=FILE_SHARE_READ Or FILE_SHARE_WRITE, _ lpSecurityAttributes:=ByVal 0&, _ dwCreationDisposition:=OPEN_EXISTING, _ dwFlagsAndAttributes:=0, _ hTemplateFile:=0)  Res = SetFileTimeCreate( _ hFile:=FileHandle, _ CreateTime:=tFileTime, _ LastAccessTime:=0&, _ LastModified:=tFileTime)  CloseHandle FileHandle  End Function