Private Sub Form_Load()
 ' Lädt die Internetseite beim Programmstart
  WebBrowser1.Navigate2 "http://www.empireofdragon.de/testcenter/test.html"
 
 ' Countdown des Timer1 für Internetseitenrefresh (was nicht funzt)
  Timer1.Interval = 1500
  Timer1.Enabled = True
 
End Sub
 
Private Function HTML_GetAllURLs( _
  ByVal sHTMLText As String) As Variant
 
  ' Alle URL-Adressen im übergebenen HTML-Text suchen
  ' und als Array zurückgeben
 
  Dim sPos As Long
  Dim ePos As Long
  Dim hPos As Integer
  Dim nCount As Long
  Dim sTemp As String
  Dim sLink As String
  Dim sURL() As String
 
  nCount = 0
  If sHTMLText <> "" Then
    ' an erster Position begonnen
    sPos = 1
    Do
      ' nach einleitendem Link-Tag suchen "<a"
      sPos = InStr(sPos, LCase$(sHTMLText), "<a ")
 
      If sPos > 0 Then
        ' <a - Tag gefunden, jetzt End-Tag suchen
        ePos = InStr(sPos, sHTMLText, ">")
        If ePos > 0 Then
 
          ' End-Tag gefunden
          ' jetzt alles zwischen sPos und ePos filtern
          sTemp = Mid$(sHTMLText, sPos, ePos - sPos)
          If InStr(Mid$(sTemp, 2), "<") = 0 Then
            ' nur wenn < nicht nochmals vorhanden ist
            sTemp = Mid$(sTemp, 4)
 
            ' jetzt nach dem Schlüsselwort "HREF" suchen
            hPos = InStr(LCase$(sTemp), "href=")
            If hPos > 0 Then
              ' gefunden... jetzt die Link-Adresse auslesen
              sLink = Mid$(sTemp, hPos + 5)
              ' Prüfen, ob "-Zeichen vorhanden,
              ' wenn ja - "ausschneiden"
              If Left$(sLink, 1) = Chr$(34) Then
                sLink = Mid$(sLink, 2)
                sLink = strLeft(sLink, Chr$(34))
              Else
                sLink = strLeft(sLink, " ")
              End If
              If Right$(sLink, 1) = Chr$(34) Then _
                sLink = Left$(sLink, Len(sLink) - 1)
 
              ' Link in URL-Array speichern
              ReDim Preserve sURL(nCount)
              sURL(nCount) = sLink
              nCount = nCount + 1
 
              ' Weitersuche ab "ePos"
              sPos = ePos - 1
            End If
          End If
        End If
        sPos = sPos + 1
      Else
        Exit Do
      End If
    Loop
  End If
 
  HTML_GetAllURLs = sURL
End Function
 
 
 
' Hilfsfunktion
Public Function strLeft(ByVal sString As String, _
  ByVal vDelimiter As Variant) As String
 
  Dim lPos As Long
 
  If VarType(vDelimiter) = vbString Then
    ' String bis zum ersten Vorkommen eines Zeichens
    ' zurückgeben
    lPos = InStr(sString, vDelimiter)
    If lPos = 0 Then lPos = Len(sString)
  Else
    lPos = Val(vDelimiter)
  End If
 
  strLeft = Left(sString, lPos)
End Function
 
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
 
Dim sHTMLText As String
  Dim sURL As Variant
  Dim I As Integer
 
  ' zunächst Seitenquelltext ermitteln
  With WebBrowser1.Document
    sHTMLText = .documentElement.OuterHTML
    WebBrowser1.Refresh2 (3)
  End With
 
  ' jetzt URLs ermitteln
  sURL = HTML_GetAllURLs(sHTMLText)
 
  ' URLs vorhanden?
  If IsArray(sURL) Then
    ' ListBox mit den URLs füllen
    List1.Clear
    For I = 0 To UBound(sURL)
      List1.AddItem sURL(I)
    Next I
  End If
 
End Sub
 
Private Sub Timer1_Timer()
 ' Hier hatte ich bisher die u.g. refresh eingefügt (ging nie) <<<<<<<<<<<
Form1.Refresh
 
End Sub