How to get Stock Quotes in Excel using VBA

Option Explicit

Const sSiteName = "https://money.rediff.com/companies/"
Const tickerID = "ltpid"    ' THE ID OF THE SPAN ON THE WEB PAGE (THIS ELEMENT WILL HAVE THE PRICE OF EACH SCRIPT)
Const sChangeID = "change"

Dim Timer

Public myConn As New ADODB.Connection
Public rs As New ADODB.Recordset
Public sQuery As String

' SET A CONNECTION. WE'LL READ DATA FROM WORKBOOK.
Sub SetConn()
    If myConn.State = adStateOpen Then
        myConn.Close
    End If

    Dim sConnString As String
    sConnString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
        "DBQ=" & ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name

    myConn.ConnectionString = sConnString
    myConn.Open         ' OPEN THE CONNECTION.
End Sub

' CALL METHODS WHEN THE FILE OPENS.
Sub Auto_Open()
    SetConn
    Call setUpdateTimer
End Sub

' REFRESH PAGE WITH NEW PRICES EVREY 10 SECONDS.
Sub setUpdateTimer()
    Timer = Now + TimeValue("00:00:10")
    Application.OnTime Timer, "updateStockPrice"
End Sub

Public Sub updateStockPrice()

    ' CREATE AN Internet Explorer OBJECT.
    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = False          ' KEEP THIS HIDDEN.
    
    ' CREATE HTML OBJECTS.
    Dim oHDoc As HTMLDocument
    Dim oHDiv As HTMLDivElement
    
    Dim sPrice As String
    Dim sChange As String
    
    Dim rng As Excel.Range      ' THE RANGE (OR CELL) WHERE WE'LL SHOW THE PRICE.

    On Error GoTo Error:

    Application.StatusBar = "Loading data. Please wait ... "

    ' QUERY TO FETCH DATA FROM A LOCAL SHEET ("Scripts").
    sQuery = "SELECT *from [Scripts$]"
    
    If rs.State = adStateOpen Then
        rs.Close
    End If
    rs.CursorLocation = adUseClient
    
    rs.Open sQuery, myConn, adOpenKeyset, adLockOptimistic
    If rs.RecordCount > 0 Then
        Do While Not rs.EOF             ' FETCH ALL THE RECORDS IN SHEET "Scripts"

            If Trim(rs.Fields("Script").Value) <> "" Then
            
                ' THE URL OF THE WEB PAGE WITH SCRIPT NAME.
                Dim URL As String
                URL = sSiteName & rs.Fields("Script").Value
            
                IE.navigate URL
    
                ' WAIT TILL INTERNET EXPLORER IS FULLY LOADED.
                While IE.readyState <> 4
                    DoEvents
                Wend
            
                ' GET THE CURRENT STOCK PRICE, CHANGE.
                Set oHDoc = IE.Document
                Set oHDiv = oHDoc.getElementById(tickerID)
                sPrice = oHDiv.innerHTML
            
                Set oHDiv = oHDoc.getElementById(sChangeID)
                sChange = oHDiv.innerHTML
            
                ' SHOW PRICE IN THEIR RESPECTIVE CELL NAME.
                Set rng = Range(rs.Fields("CellName").Value)
                rng.Value = sPrice
            
                ' SHOW THE CHANGES IN THE CURRENT STOCK PRICES, WITH COLORS.
                Cells(rng.row, rng.Column + 1) = sChange
                If Val(sChange) < 0 Then
                    Cells(rng.row, rng.Column + 1).Font.ColorIndex = 3  ' RED, IF ITS IN NEGATIVE.
                Else
                    Cells(rng.row, rng.Column + 1).Font.ColorIndex = 10 ' GREEN, IF POSITIVE.
                End If
            End If

            rs.MoveNext
        Loop

        ' CLOSE AND RELEASE.
        rs.Close
        Set rs = Nothing
        
        myConn.Close
        Set myConn = Nothing
        
        Application.StatusBar = "Price Updated"         ' UPDATE  STATUS BAR.
    Else
        Application.StatusBar = "No data found. Please check sheet 'Scripts'."
        Exit Sub
    End If
Error:
    On Error Resume Next

    Set IE = Nothing            ' EXIT INTERNET EXPLORER.
    Call setUpdateTimer         ' RESET TIMER.
End Sub

Sub SetConn()
…
End Sub

Sub Auto_Open()
…
End Sub

Sub setUpdateTimer()
    Timer = Now + TimeValue("00:00:10")
    Application.OnTime Timer, "updateStockPrice"
End Sub