Udrag tekst fra .htm-fil i VB6

Option Explicit

Private Sub Form_Load()
Dim strTest As String
  strTest = "<td colspan=""2"" class=""subheader""><strong>Rockwool A/S</strong></td>"
  Me.Caption = FindTags(strTest, "<strong>", "</strong>")
End Sub

Public Function FindTags(strData As String, strTag1 As String, strTag2 As String) As String
Dim intStart As Long
Dim intEnd As Long
  intStart = InStr(1, strData, strTag1, vbTextCompare)
  If intStart > 0 Then
    intStart = (intStart + Len(strTag1))
    intEnd = InStr(intStart, strData, strTag2, vbTextCompare)
    If intEnd > 0 Then
      FindTags = Mid$(strData, intStart, (intEnd - intStart))
    End If
  End If
End Function

tak -
kigger lige på det..

' Du kan også tag alle tags sådan.. HUSK en List1 ;)
Option Explicit

Private Sub Form_Load()
Dim i As Integer
Dim strTest As String
Dim arrTest As Variant

  strTest = "<td colspan=""2"" class=""subheader""><strong>Rockwool A/S</strong></td><strong>Rockwool A/S 2</strong>"

  arrTest = FindTags(strTest, "<strong>", "</strong>")
  For i = LBound(arrTest) To UBound(arrTest)
    List1.AddItem arrTest(i) ' <- Tilføj til List1
  Next
End Sub

Public Function FindTags(strData As String, strTag1 As String, strTag2 As String) As Variant
Dim intEnd As Long
Dim intStart As Long
Dim arrTags() As String
Dim intTagsCount As Integer

  intStart = 1
  Do While intStart
    intStart = InStr(intStart, strData, strTag1, vbTextCompare)
    If intStart > 0 Then
      intStart = (intStart + Len(strTag1))
      intEnd = InStr(intStart, strData, strTag2, vbTextCompare)
      If intEnd > 0 Then
        intTagsCount = (intTagsCount + 1)
        ReDim Preserve arrTags(1 To intTagsCount) As String
        arrTags(intTagsCount) = Mid$(strData, intStart, (intEnd - intStart))
       
      End If
    End If
  Loop

  If intTagsCount > 0 Then
    FindTags = arrTags
      Else
    FindTags = Array()
  End If
End Function

jeg ""-tegnene giver problemer i strTest

nogen forslag?

strTest = "<td colspan=""2"" class=""subheader""><strong>Rockwool A/S</strong></td><strong>Rockwool A/S 2</strong>"

;)

arr.. der skal være 2 "" for at få 1 .. eksperten piller 1 ud ved: "<td colspan=""2"" class

>>Sjh
Det virker fint - læg et svar.

Har du også lige en hurtig kode til at kontrollere hvor mange gange "<br>" optræder i en sætning? :-)

Tak for hjælpen.

Har selv løst "<br>" -problematikken:

Public Function TaelBR(StrNg As String) As Integer
Dim tmpStr As String
Dim tmpNr As Integer
tmpNr = 0
For X = 1 To Len(StrNg)
    tmpStr = Mid(StrNg, X, 4)
    If tmpStr = "<br>" Then
        tmpNr = tmpNr + 1
        TaelBR = tmpNr
    End If
Next
End Function

du kan også lave din funktion multi

Public Function CountTags(strData As String, strTag As String) As Long
Dim i As Long
Dim tmpTag As String
Dim intCount As Long
  For i = 1 To Len(strData)
    tmpTag = Mid$(strData, i, Len(strTag))
    If LCase$(tmpTag) = LCase$(strTag) Then
      intCount = (intCount + 1)
    End If
  Next
  CountTags = intCount
End Function

Private Sub Form_Load()
  Me.Caption = CountTags("<br><BR><BR><BR><BR><BR><br><br>", "<br>")
End Sub

Endnu engang tak for hjælpen.