htmlvbaexcelscripting.dictionary

Store all the items from a HTML table in to a Scripting Dictionary, adding also the duplicates values


I want to store in a dictionary all the items found in a html table.

I have problems when I have duplicates, because my below code don't store again the item, and I need all the items from this table, even if there is any duplicate.

If I have duplicate values like Round 38, where another Match3 has the same round number, I want to list again those duplicate values.

The results should look like this:

Round 38

Match1

Match2

Round 37

Match1

Match2

Round 38

Match3

Match4

..............

Sub Get_URL_Addresses_test()

Dim URL As String
Dim ie As New InternetExplorer
Dim HTMLdoc As HTMLDocument
Dim dictObj As Object: Set dictObj = CreateObject("Scripting.Dictionary")
Dim tRowID As String

URL = "http://www.flashscore.ro/fotbal/anglia/premier-league-2015-2016/rezultate/"

With ie
    .navigate URL
    .Visible = True
    Do Until .readyState = READYSTATE_COMPLETE: DoEvents: Loop
    Set HTMLdoc = .document
End With


For Each objLink In ie.document.getElementsByTagName("a")

   If Left(objLink.innerText, 4) = "Show" Or Left(objLink.innerText, 4) = "Arat" Then

        objLink.Click
        Application.Wait (Now + TimeValue("0:00:01"))
        objLink.Click
        Application.Wait (Now + TimeValue("0:00:01"))
        objLink.Click
        Application.Wait (Now + TimeValue("0:00:01"))
        'Exit For

   End If

Next objLink


With HTMLdoc

    Set tblSet = .getElementById("fs-results")
    Set mTbl = tblSet.getElementsByTagName("tbody")(0)
    Set tRows = mTbl.getElementsByTagName("tr")
    With dictObj

        For Each tRow In tRows

            If tRow.getAttribute("Class") = "event_round" Then
                tRowClass = tRow.innerText
                'MsgBox tRowClass
                If Not .Exists(tRowClass) Then
                    .add tRowClass, Empty
                End If
            End If

            tRowID = Mid(tRow.ID, 5)
            If Not .Exists(tRowID) Then
                .add tRowID, Empty
            End If


        Next tRow
    End With
End With

i = 14
For Each Key In dictObj

    If Left(Key, 5) = "Runda" Or Left(Key, 5) = "Round" Then
        ActiveSheet.Cells(i, 2) = Key
    Else
        ActiveSheet.Cells(i, 2) = "http://www.flashscore.ro/meci/" & Key & "/#sumar-meci"
    End If

    i = i + 1

    'MsgBox Key
    'Debug.Print Key
Next Key

Set ie = Nothing
MsgBox "Process Completed"

End Sub

Solution

  • You could store your items in a generic container that allows duplicates, such as collection or array. But since you are storing them in a dictionary, as keys, it probably means that you want later a fast search for existence of some items. A possible solution would be to "count" the number of appearances of each item (key) and store this number in the corresponding value field.

    If tRow.getAttribute("Class") = "event_round" Then
        tRowClass = tRow.innerText
        dim n as Integer: n = dictObj.Item(tRowClass) ' creates and returns 0 if no exist yet
        dictObj.Item(tRowClass) = n + 1
    End If
    

    Later you will be able check for the existence of any key in the dictionary and also you have the number of appearances of that key.

    EDIT

    As I suspected, you're using the dictionary just as a normal container, but since you want to allow for duplicates, Dictiobary is not the way you go. Just use a Collection. Here's the minimal change to your code:

    Set dictObj = CreateObject("Scripting.Dictionary") --> Set dictObj = new Collection

    If Not .Exists(tRowClass) Then .add tRowClass, Empty End If

    Replace the above stuff (3 line) with:

    .add tRowClass
    

    That's it.