Quote real time prices from aastock

[henryvii99]

Hello everyone,

I had a UDF which can quote the real time prices from aastock, which basically found the span class "pos bold","neg bold" or "unc bold" in the html (May thanks to pbornemeier!)

The site is:
http://www.aastocks.com/en/ltp/rtquote.aspx?symbol=00008

The code is:

 Dim aryTypes As Variant
    
    aryTypes = Array("pos bold", "neg bold", "unc bold")
 
    On Error GoTo er
    Set xlhttp = CreateObject("Msxml2.XMLHTTP")
    With xlhttp
        .Open "get", "http://www.aastocks.com/sc/ltp/rtquote.aspx?symbol=" & dm & "&time=" & Timer, False
        .send
 
        sOutput = StrConv(.responsebody, vbUnicode)
        For lx = LBound(aryTypes) To UBound(aryTypes)
            lPosition = InStr(sOutput, aryTypes(lx))
            If lPosition > 0 Then 'search value was found
                sExtract = Mid(sOutput, lPosition, 100) 'get enough of a string to include the % if it exists
                'Debug.Print aryTypes(lx), Trim(sExtract)
                If InStr(sExtract, "%") > 0 Then
                    'Don't want
                Else
                    sType = aryTypes(lx)
                    Exit For
                End If
            End If
        Next
        
        sExtract = Mid(sExtract, InStr(sExtract, ">") + 1, 100)
        StockVal = Left(sExtract, InStr(sExtract, "<") - 1)
        'Debug.Print dm, sType, StockVal
        
    End With
    Set xlhttp = Nothing
    Exit Function
er:
    StockVal = "err"
End Function

Now I want to quote the volume by Excel UDF, which is the first div class named "floatR p2" in the elements. This class will not give any weird outputs (sometimes the price gives a percentage and therefore need a lot of codes to troubleshoot) as in above, so I tried to modify the codes, but it doesn't work.

Many thanks in advance!!

 

[henryvii99]