Option Explicit
 
' Library Scripting
' C:\WINDOWS\system32\scrrun.dll
' Microsoft Scripting Runtime
' Die hab ich immer   ; - )
' -  muss evtl unter Tools / References im VBA Fenster eingebunden werden 
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As _
  Boolean)
Dim Sfil As String
Dim Stmp As String
Dim S() As String
Dim i As Long
Dim rw As Long
dim FSO As New FileSystemObject
dim FST As Scripting.TextStream
RF.Cells.EntireRow.Delete
Set FST = FSO.OpenTextFile("C:\Documents and Settings\<...>\Application" & _
  "Data\Mozilla\Firefox\Profiles\sgujno7c.default\history.dat")
Sfil = FST.ReadAll
FST.Close
S() = Split(Sfil, vbCrLf)
Sfil = ""
ActiveSheet.Cells(2, 2).Select
ActiveWindow.FreezePanes = True
ActiveSheet.Cells(1).Select
ActiveSheet.Cells(1).NumberFormat = "0.00%"
ActiveSheet.Cells(1).Font.Size = 48
ActiveSheet.Columns(1).ColumnWidth = 50
For i = 1 To UBound(S())
    ActiveSheet.Cells(1) = i / UBound(S())
    DoEvents
    If Right(S(i), 1) = "\" Then
        Sfil = Sfil & Left(S(i), Len(S(i)) - 1)
    Else
        Sfil = Sfil & S(i)
    End If
Next i
Do
    i = Len(Sfil)
    Sfil = Replace(Sfil, ") ", ")")
Loop While i <> Len(Sfil)
S() = Split(Sfil, ")(")
rw = 1
For i = 1 To UBound(S())
    ActiveSheet.Cells(1) = i / UBound(S())
    DoEvents
    If InStr(S(i), "http") Then
        rw = rw + 1
        ActiveSheet.Rows(rw).Select
        ActiveSheet.Cells(rw, 1) = Split(S(i), "=")(1)
    End If
Next i
End Sub