Reading HTML OL as a variant array

[mc84excel]

I have this Ordered List (OL) element read and set to an object variable in a VBA function I'm working on

I'm trying to work out some way I can read all rows/columns to a 2D array. Is this doable?

Also; Would it be possible to make this generic enough so it could be reusable for any OL element or is that wishful thinking? (I never learnt HTML so don't laugh :S )

[Leith Ross]

Hello mc84excel,

It would help if you posted the HTML code you want to parse.

[mc84excel]

Thanks Leith Ross but the most pressing need I have for this contains too much confidential data to easily remove. Also I am after a function that is reusable for any OL element

[Kyle123]

Like this:

Dim ol      As HTMLListElement
Dim li      As HTMLLIElement
Dim x       As Long
Dim data()  As String

With New HTMLDocument

    .body.innerHTML = "<ol id='OrderedList'><li>Point1</li><li>Point2</li></ol>"
    
    Set ol = .getElementById("OrderedList")
    ReDim data(1 To ol.Children.Length)
    
    For Each li In ol.Children
        x = x + 1
        data(x) = li.innerText
    Next li

End With

[mc84excel]

Sorry Kyle, my mistake. I have stuffed up again.

Firstly thank you for the code provided +1 for that

My problem is that I forgot to specify in the opening post that I was looking to return a 2D array!

Dont worry about it. I am tinkering away on this and in a day or so I will know if there is any chance of success (or not)

[Norie]

Why a 2D array?

What would be in the second dimension?

[mc84excel]

Why a 2D array?

What would be in the second dimension?

Columns.

For example The OL I am most interested in is an online contacts directory. Each page is an OL element. Each contact is a new LI element in that OL. And there are phone/email etc details inside each of these LI elements.

[Kyle123]

Then you're going to need to post some markup

[mc84excel]

I solved it.

Each item I wanted to pick up is a span element of the li element. So I set an object to hold all the span elements of the li element and then loop through those, recording the innertext value (if exists) & recording the span classname as the field/header name.

Some of the span elements are nested. So I added an optional argument 'blnOnlyReturnBaseData' to only record the field & value if the span element length was 0.

extract below

...rest of function

    'get collection of LI in OL element
    Set objCollectionLI = objCollectionLI.getElementsByTagName("li")
    If objCollectionLI Is Nothing Then
        GoTo ExitProcedure
    End If
    On Error GoTo 0

    alngRow = objCollectionLI.Length
    alngHeaders = 1
    ReDim avarOutput(1 To alngRow, 1 To alngHeaders)
    ReDim avarHeaders(1 To alngHeaders)

    'loop through each LI & populate array
    For alngRow = LBound(avarOutput, 1) To UBound(avarOutput, 1)

        'grab collection of child objects for row (LI)
        Set objCollectionSPAN = objCollectionLI(alngRow - 1).getElementsByTagName("span")

        If Not blnOnlyReturnBaseData Then
            'expand arrays for any extra columns
            alngHeaders = UBound(avarHeaders)
            alngColSPAN = objCollectionSPAN.Length
            If alngColSPAN > alngHeaders Then
                alngHeaders = alngColSPAN
                ReDim Preserve avarOutput(LBound(avarOutput, 1) To UBound(avarOutput, 1), 1 To alngHeaders)
                ReDim Preserve avarHeaders(1 To alngHeaders)
            End If
        End If

        'loop through columns - headers
        For alngColSPAN = 1 To objCollectionSPAN.Length

            If Not blnOnlyReturnBaseData Then
                'populate is default
                blnPopulateHeader = True
                blnAlreadyMatched = False
            Else
                blnPopulateHeader = (objCollectionSPAN(alngColSPAN - 1).all.Length = 0)
                blnAlreadyMatched = False
            End If

            If blnPopulateHeader Then
                'check for match #1 (same col)
                If Not alngColSPAN > UBound(avarHeaders) Then
                    If avarHeaders(alngColSPAN) = objCollectionSPAN(alngColSPAN - 1).Classname Then
                        'already matched
                        'so dont populate
                        blnAlreadyMatched = True
                        blnPopulateHeader = False
                    End If
                End If

                'check for match #2 (other cols)
                If Not blnAlreadyMatched Then
                    If fnlngGetPositionOfArgIn1dArr(avarHeaders, objCollectionSPAN(alngColSPAN - 1).Classname) > 0 Then
                        'match found in another col
                        'so dont populate
                        blnAlreadyMatched = True
                        blnPopulateHeader = False
                    End If
                End If

                'populate + no match found
                If Not blnAlreadyMatched Then
                    'set alngHeaders
                    If Not alngColSPAN > UBound(avarHeaders) Then
                        alngHeaders = alngColSPAN
                        If Len(avarHeaders(alngHeaders)) > 0 Then
                            alngHeaders = UBound(avarHeaders)
                        End If
                    Else
                        alngHeaders = UBound(avarHeaders)
                    End If

                    'if field in header arr already in use, expand arrs by 1
                    If Len(avarHeaders(alngHeaders)) > 0 Then
                        alngHeaders = UBound(avarHeaders) + 1
                        ReDim Preserve avarOutput(LBound(avarOutput, 1) To UBound(avarOutput, 1), 1 To alngHeaders)
                        ReDim Preserve avarHeaders(1 To alngHeaders)
                    End If

                    'add new field to header arr (this element always empty due to fix above)
                    avarHeaders(alngHeaders) = objCollectionSPAN(alngColSPAN - 1).Classname
                End If
            End If

        Next alngColSPAN


        'loop through columns - data
        For alngColSPAN = 1 To objCollectionSPAN.Length

            If Not blnOnlyReturnBaseData Then
                'populate is default
                blnPopulateHeader = True
            Else
                blnPopulateHeader = (objCollectionSPAN(alngColSPAN - 1).all.Length = 0)
            End If

            If blnPopulateHeader Then

                If alngColSPAN > UBound(avarHeaders) Then
                    'this to avoid err 9 on next
                    alngHeaders = UBound(avarHeaders)
                Else
                    alngHeaders = alngColSPAN
                End If

                'locate position and use to set alngHeaders
                If objCollectionSPAN(alngColSPAN - 1).Classname = avarHeaders(alngHeaders) Then
                    'matched, so use SPAN col
                    alngHeaders = alngColSPAN
                Else
                    'locate col to use in header arr
                    alngHeaders = fnlngGetPositionOfArgIn1dArr(avarHeaders, objCollectionSPAN(alngColSPAN - 1).Classname)
                End If

                'copy innertext to arr
                On Error Resume Next
                If Len(objCollectionSPAN(alngColSPAN - 1).innertext) > 0 Then
                    avarOutput(alngRow, alngHeaders) = objCollectionSPAN(alngColSPAN - 1).innertext
                End If
                On Error GoTo 0
            End If

        Next alngColSPAN


        'scrap object
        If Not TypeName(objCollectionSPAN) = "Nothing" Then
            Set objCollectionSPAN = Nothing
        End If
    Next alngRow


    If IsArray(avarOutput) Then
        ReDim avarJagged(1 To 2)
        avarJagged(1) = avarOutput
        avarJagged(2) = avarHeaders
    End If

...rest of function