Saturday, December 1, 2018

Get Historical Data from NSE using VBA and Internet Explorer,VBA Teacher Sourav,Kolkata 08910141720


Public Sub downloadData()
'Open an excel sheet and rename one of the sheets as "DailyData". The data will be
'copied to that sheet

Dim frmDate As String, toDate As String, scrip As String
frmDate = DateSerial(2017, 5, 22)
frmDate = Format(frmDate, "dd-mm-yyyy")
toDate = DateSerial(2017, 5, 26)
toDate = Format(toDate, "dd-mm-yyyy")
scrip = "DABUR"
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("DailyData")

'Call subroutine to download the data
getNSE_post frmDate, toDate, 1, 1, scrip, ws

End Sub


Sub getNSE_post(frmDate As String, toDate As String, nRow As Integer, _
nCol As Integer, scrip As String, ws As Worksheet)
Dim str As String
Dim ie As Object
Dim frm As Variant
Dim element, submitInput As Variant
Dim rowCollection, htmlRow As Variant
Dim rowSubContent, rowSubData As Variant
Dim i, j, k, pauseTime As Integer
Dim anchorRange As Range, cellRng As Range
Dim start

Set ie = CreateObject("InternetExplorer.Application")
ie.navigate "https://www.nseindia.com/products/content/equities/equities/eq_security.htm"
While ie.readyState <> 4: DoEvents: Wend

'try to get form by ID
Set frm = ie.document.getElementById("histForm")

ie.Visible = True
ie.document.getElementById("dataType").Value = "priceVolumeDeliverable"
ie.document.getElementById("symbol").Value = scrip
ie.document.getElementById("segmentLink").Value = 3
ie.document.getElementById("symbolCount").Value = 1
ie.document.getElementById("series").Value = "EQ"
'ie.document.getElementById("dateRange").Value = "day"
ie.document.getElementById("rdPeriod").Checked = True
ie.document.getElementById("fromDate").Value = frmDate
ie.document.getElementById("toDate").Value = toDate

'Pause For User To See Entry
pauseTime = 2 ' Set duration in seconds
start = Timer ' Set start time.
Do While Timer < start + pauseTime
DoEvents ' Yield to other processes.
Loop

For Each submitInput In ie.document.getelementsbytagname("INPUT")
If InStr(submitInput.getAttribute("onclick"), "submitData") Then
submitInput.Click
Exit For
End If
Next


 k = ActiveWorkbook.Sheets.Count

    For i = k To 1 Step -1
        t = Sheets(i).Name
        If t = "Full Table" Then
            Application.DisplayAlerts = False
                Sheets(i).Delete
            Application.DisplayAlerts = True
           
        End If
    Next i
On Error Resume Next
  ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)).Name = "Full Table"
  
Set anchorRange = Sheets("Full Table").Cells(1, 1)
i = 0 'The header row needs to be omitted

Set rowCollection = ie.document.getelementsbytagname("tr")
For Each htmlRow In rowCollection
Set rowSubContent = htmlRow.getelementsbytagname("td")
k = 0
For Each rowSubData In rowSubContent

anchorRange.Offset(i, k).Value = rowSubData.innerText
k = k + 1


Next rowSubData

i = i + 1
Next htmlRow

End Sub



No comments:

Post a Comment