[RESOLVED] Help me get this text!

[Motaro]

Code:

    Dim strText As String
    Dim x As Long, y As Long
    strText = Inet1.OpenURL("http://rscangel.org/highscores.php?skill=attack")


    y = InStr(1, strText, "<td>1</td>")
    If y Then
        x = InStr(y + 20, strText, ">")
        If x Then
           y = InStr(x, strText, "</td>")
           If y Then
                Label22.Caption = Mid$(strText, x + 1, (y - x) - 1)
            End If
        End If
    End If

Site's source code bit:

<td>1</td><td>nitrokyrpa</td><td>99</td><td>

I'm trying to extract 99. 99 only.

With the code above it displays "<td>99" instead of "99"


Been working with this forever! Just can't get get rid of 4 characters.

[Merri]

Start a new project, add Inet1 and List1 to the form and paste:

Option Explicit

' move this function to a module
Public Function InStrBetween(ByRef Search As String, ByRef StringBegin As String, ByRef StringEnd As String, Optional ByVal Start As Long = 1, Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As String
    Dim lngLenSea As Long, lngLenBeg As Long, lngLenEnd As Long
    Dim lngBegin As Long, lngEnd As Long
    Dim strSearch As String, strBegin As String, strEnd As String
    ' get string lengths
    lngLenSea = LenB(Search)
    lngLenBeg = LenB(StringBegin)
    lngLenEnd = LenB(StringEnd)
    ' make sure we have lengths and a valid starting position
    If (lngLenSea <> 0) And (lngLenBeg <> 0) And (lngLenEnd <> 0) And (Start > 0) Then
        ' make start a byte position
        Start = ((Start - 1) * 2) + 1
        ' case sensitive?
        If Compare = vbBinaryCompare Then
            ' find the starting position
            lngBegin = InStrB(Start, Search, StringBegin, vbBinaryCompare)
            ' because InStrB finds byte positions, we have to ensure we do not get "mid character" positions
            Do While ((lngBegin And 1) = 0) And (lngBegin > 0)
                lngBegin = InStrB(lngBegin + lngLenBeg, Search, StringBegin, vbBinaryCompare)
            Loop
            If lngBegin Then
                lngBegin = lngBegin + lngLenBeg
                ' find the ending position
                lngEnd = InStrB(lngBegin, Search, StringEnd, vbBinaryCompare)
                ' because InStrB finds byte positions, we have to ensure we do not get "mid character" positions
                Do While ((lngEnd And 1) = 0) And (lngEnd >= lngBegin)
                    lngEnd = InStrB(lngEnd + lngLenEnd, Search, StringEnd, vbBinaryCompare)
                Loop
                ' make sure we have something
                If lngEnd > lngBegin Then
                    ' return the result
                    InStrBetween = MidB$(Search, lngBegin, lngEnd - lngBegin)
                End If
            End If
        Else
            ' make upper case copies
            strSearch = UCase$(Search)
            strBegin = UCase$(StringBegin)
            ' find the starting position
            lngBegin = InStrB(Start, strSearch, strBegin, vbBinaryCompare)
            ' because InStrB finds byte positions, we have to ensure we do not get "mid character" positions
            Do While ((lngBegin And 1) = 0) And (lngBegin > 0)
                lngBegin = InStrB(lngBegin + lngLenBeg, strSearch, strBegin, vbBinaryCompare)
            Loop
            If lngBegin Then
                lngBegin = lngBegin + lngLenBeg
                ' make upper case copy
                strEnd = UCase$(StringEnd)
                ' find the ending position
                lngEnd = InStrB(lngBegin, strSearch, strEnd, vbBinaryCompare)
                ' because InStrB finds byte positions, we have to ensure we do not get "mid character" positions
                Do While ((lngEnd And 1) = 0) And (lngEnd >= lngBegin)
                    lngEnd = InStrB(lngEnd + lngLenEnd, strSearch, strEnd, vbBinaryCompare)
                Loop
                ' make sure we have something
                If lngEnd > lngBegin Then
                    ' return the result
                    InStrBetween = MidB$(Search, lngBegin, lngEnd - lngBegin)
                End If
            End If
        End If
    End If
End Function

Private Sub Form_Load()
    Dim strText As String, strRows() As String
    Dim x As Long, y As Long
    strRows = Split(InStrBetween(Inet1.OpenURL("http://rscangel.org/highscores.php?skill=attack"), _
        "<h2><center>Top 20 players for attack</center></h2><br><table width=""100%""><tr><td>Rank</td><td>Player</td><td>Level</td><td>Exp</td><tr><tr><td>", _
        "</td></table>"), "</td><tr><td>")
    For x = 0 To UBound(strRows)
        List1.AddItem Replace(strRows(x), "</td><td>", vbTab)
    Next x
End Sub

Just use Split again instead of replace if you want to store all the information

[LucianoBraatz]

You are almost there... try this:

    Dim strText As String
    Dim x As Long, y As Long
    strText = Inet1.OpenURL("http://rscangel.org/highscores.php?skill=attack")
    y = InStr(1, strText, "<td>1</td>")
    If y Then
        x = InStr(y + 20, strText, ">")
        If x Then
           y = InStr(x, strText, "</td>")
           If y Then
                Label22.Caption = Mid$(strText, x + 5, y - x - 5)
            End If
        End If
    End If

What happend is that you get the colored part in the string:

<td>1</td><td>nitrokyrpa</td><td>99</td><td>

Where you put x+1 getting "<td>99", I put x+5, and get "99</td", so I fixed the "</td" part, modifying the (y-x)-1 into y-x-5.

[ydiouri]

I don't understand what you wanna do, but this works

99 = Mid(strText, 34, 2)

Of course it will only work with this string

[Motaro]

You are almost there... try this:

    Dim strText As String
    Dim x As Long, y As Long
    strText = Inet1.OpenURL("http://rscangel.org/highscores.php?skill=attack")
    y = InStr(1, strText, "<td>1</td>")
    If y Then
        x = InStr(y + 20, strText, ">")
        If x Then
           y = InStr(x, strText, "</td>")
           If y Then
                Label22.Caption = Mid$(strText, x + 5, y - x - 5)
            End If
        End If
    End If

What happend is that you get the colored part in the string:

<td>1</td><td>nitrokyrpa</td><td>99</td><td>

Where you put x+1 getting "<td>99", I put x+5, and get "99</td", so I fixed the "</td" part, modifying the (y-x)-1 into y-x-5.

Awesome! Thanks a lot!