Option Explicit
 
Private databuffer As String
Private mDirty As Long
 
 
Function GetRawInfos(HTML As String) As String
' Diese Funktion nimmt ein paar Anpassungen am herausgeschittenen
' HTML-Quellcode vor damit die Anzeige von eher unnötigen Zeichen
' befreit ist.
 
    On Error Resume Next
    Dim Pos As Long, Pos2 As Long
    Dim strTemp1 As String, strTemp2 As String
 
    ' HTML-Tags entfernen
    Pos = InStr(1, HTML, "<")
 
    Do While Pos > 0
        Pos2 = InStr(Pos + 1, HTML, ">")
        strTemp1 = Mid$(HTML, 1, Pos - 1)
        strTemp2 = Mid$(HTML, Pos2 + 1)
        HTML = strTemp1 & " " & strTemp2
        Pos = InStr(1, HTML, "<")
    Loop
 
    ' Zeilenumbrüche konform machen (wetter.net spezifisch)
    HTML = Replace$(HTML, vbLf, vbCrLf, , , vbTextCompare)
 
    ' doppelte Leerzeichen entfernen
    While InStr(1, HTML, "  ", vbTextCompare) > 0
        HTML = Replace$(HTML, "  ", " ", , , vbTextCompare)
    Wend
 
    ' Umwandlung einiger HTML-Entitäten in ihre Repräsentationen
    HTML = Replace$(HTML, "ä", "ä", , , vbTextCompare)
    HTML = Replace$(HTML, "ö", "ö", , , vbTextCompare)
    HTML = Replace$(HTML, "ü", "ü", , , vbTextCompare)
    HTML = Replace$(HTML, "A", "Ä", , , vbTextCompare)
    HTML = Replace$(HTML, "Ö", "Ö", , , vbTextCompare)
    HTML = Replace$(HTML, "Ü", "Ü", , , vbTextCompare)
 
    GetRawInfos = Trim$(HTML)
End Function
 
Private Sub Inet1_StateChanged(ByVal State As Integer)
    ' Wenn Daten komplett erhalten, alle Daten abrufen
    If State = icResponseCompleted Then
        Dim chunk As String
 
        chunk = Inet1.GetChunk(1024, icString)
        databuffer = chunk
        While Len(chunk) > 0
            chunk = Inet1.GetChunk(1024, icString)
            databuffer = databuffer & chunk
        Wend
    End If
End Sub
 
Private Sub Command1_Click()
    On Error GoTo ErrHANDLER
    Dim SiteHTML As String
    Dim ErgStr As String
    Dim Pos1 As Long, Pos2 As Long
    Dim W1 As String, W2 As String
 
    Inet1.Cancel
 
Dim I As Long
With lstLink
  For I = 0 To .ListCount - 1
    W1 = Trim$(lstLink.List(I))
    W2 = Trim$(lblLink2.Caption)
 
    Inet1.AccessType = icUseDefault
    Inet1.Execute Trim$( _
      "http://www.discounter-archiv.de/de/preisliste/ALDI-Nord/Backwaren/")
    While Inet1.StillExecuting
        DoEvents
    Wend
    SiteHTML = databuffer
    Pos1 = InStr(1, SiteHTML, W1)
    Pos2 = InStr(Pos1 + Len(W1), SiteHTML, W2)
    ErgStr = Mid$(SiteHTML, Pos1 + Len(W1), Pos2 - (Pos1 + Len(W1)))
    Text1.Text = Text1.Text & GetRawInfos(ErgStr) & vbCrLf
  Next I
End With
Exit Sub
ErrHANDLER:
    Inet1.Cancel
End Sub

   <td><a _
     href="http://www.discounter-archiv.de/de/preisliste/ALDI-Nord/Brot/Baguet" & _
     "es/902/">Baguettes</a></td>
          <td>0.39</td>
usw.

lblLink2.Caption = "</a></td>"