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