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