Private Sub CommandButton1_Click()
Dim shortcutfile As String
Dim myadddate As Double

    Application.ScreenUpdating = False
    myfullfilename = Application.GetSaveAsFilename(InitialFileName:="Bookmarks.html", fileFilter:="HTML Files, *.html")

    If myfullfilename = False Then Exit Sub
    mypath = Left$(myfullfilename, InStrRev(myfullfilename, "\")) & "InternetShortCuts"
    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(.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_MODIFIED=")
            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)

            forbidden = Array("\", "/", ":", "*", "?", """", "<", ">", "|", "&quot;")
            For j = 0 To UBound(forbidden)
                mytitle = Replace(mytitle, forbidden(j), "")
            Next j

            shortcutfile = mypath & "\" & Trim(mytitle) & ".url"
            With CreateObject("Scripting.FileSystemObject")
              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