Using VBA to submit form and download data

A

adhwn

New Member
Joined
Nov 27, 2017
Messages
8
Hi all,

My objective is to automate the download the current futures data from the website www.nseindia.com. For this, I tried using the following code:

Sub Test1()


Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")


IE.Visible = True
IE.Navigate "http://www.nseindia.com/products/content/derivatives/equities/historical_fo.htm"


Do While IE.Busy


Application.Wait DateAdd("s", 1, Now)


Loop


Set doc = IE.document


doc.GetElementById("instrumentType").Value = Range("A2")


doc.GetElementById("symbol").Value = Range("B2")
'doc.GetElementById("year").Value = Range("C2")
'doc.GetElementById("expiryDate").Value = Range("D2")


'doc.GetElementById("rdDateToDate").******* = "makeReadonly()"


'doc.GetElementById("fromDate").Value = Range("E2")
'doc.GetElementById("toDate").Value = Range("F2")






'doc.GetElementById("getButton").Click






End Sub

A2 = FUTIDX
B2 = NIFTY
C2 = 2000
D2 = 29-06-2000
E2 = 12-06-2000
F2 = 29-06-2000


After selecting the first drop, down nothing else works. My research led me to understand that this cannot be done using IE. Accordingly, I tried installing a Selenium wrapper and then tried with the following code:

Sub ChromeAutomation()
Chrome.Start: Chrome.Get "https://www.google.it/"
End Sub

However, excel throws up an error at .start.

The volume of data to be downloaded does not lend itself to manual work and thus I'd be grateful for any solutions to achieve the desired objective. Many thanks in advance.
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
Hi,

Here code that works with Internet Explorer

Regards,

Code: 
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]'Using VBA to submit form and download data
Sub GetFromWeb()
Dim IE As Object
Dim doc As Object
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    IE.Navigate "http://www.nseindia.com/products/content/derivatives/equities/historical_fo.htm"
    Do While IE.Busy Or (IE.ReadyState <> 4)
        DoEvents
    Loop
    Set doc = IE.Document
    Call SelectFromList(doc.GetElementById("instrumentType"), Range("A2").Text)
    Call SelectFromList(doc.GetElementById("symbol"), Range("B2").Text)
    Call SelectFromList(doc.GetElementById("year"), Range("C2").Text)
    Call SelectFromList(doc.GetElementById("expiryDate"), Range("D2").Text)
    doc.GetElementById("rdDateToDate").Click
    doc.GetElementById("fromDate").Value = Range("E2").Text
    doc.GetElementById("toDate").Value = Range("F2").Text
    doc.GetElementById("getButton").Click
    If WorksheetExists("Sheet2") = False Then Sheets.Add.Name = "Sheet2"
    Call TransferData(doc, Sheets("Sheet2"))
    IE.Quit
    Set IE = Nothing
End Sub[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Private Sub TransferData(ByRef doc As Object, ByRef inSheet As Object)
Dim Tab1 As Object
Dim Tr As Object
Dim Td As Object
Dim Colstart As Long
Dim i As Long, j As Long, n As Long
   Colstart = 1
   j = 2
   i = Colstart
   n = 0
   'Loop Through website tables
   For Each Tab1 In doc.getElementsByTagName("table")
      With doc.getElementsByTagName("table")(n)
         For Each Tr In .Rows
            For Each Td In Tr.Cells
               inSheet.Cells(j, i) = Td.innerText
               i = i + 1
            Next Td
            i = Colstart
            j = j + 1
          Next Tr
      End With
      n = n + 1
      i = Colstart
      j = j + 1
   Next Tab1
End Sub[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Private Sub SelectFromList(ByRef objElement As Object, ByVal optionselected As String)
    objElement.Value = optionselected
    objElement.FireEvent "onchange"
    DoEvents
End Sub[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Private Function WorksheetExists(ByVal WorksheetName As String) As Boolean
Dim Sht As Worksheet
    WorksheetExists = True
    For Each Sht In ActiveWorkbook.Worksheets
        If Sht.Name = WorksheetName Then Exit Function
    Next Sht
    WorksheetExists = False
End Function
[/FONT]
 
Upvote 0
Hey,

Many thanks for this. However, the code does not seem to work for me.

Could it be that my settings are not optimal?

All I reach is a point where the submit button is to be clicked - but doesnt get clicked and also an additional sheet gets inserted in the master workbook.

Thanks again for helping out.
 
Upvote 0
Hi,

Add the following line before the line "
Call TransferData(doc, Sheets("Sheet2"))"​
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif][FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Do
DoEvents
Loop While IE.Busy Or (IE.ReadyState <> 4)[/FONT]

Sometime the VBA code is to fast for the web site.
The table result is copied on Sheet2

Regards,
Rino
[/FONT]
 
Upvote 0
Thanks again for taking the time on this.

I took a screenshot of what I can see (I had removed the IE.Quit), but not sure how to post it here.

Essentially, the same problem occurs. As an additional observation, the expiry date also does not get selected.

Not sure how to resolve this.
 
Upvote 0
Hi,

I did some small modification on the code to wait for internet.

Here the new code, (I comment out the IE.QUIT)

Rich (BB code): 
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Option Explicit
'For ADHWN : Using VBA to submit form and download data
Sub GetFromWeb()
Dim IE As Object
Dim doc As Object
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    IE.Navigate "http://www.nseindia.com/products/content/derivatives/equities/historical_fo.htm"
    Call WaitWeb(IE)
    Set doc = IE.Document
    Call SelectFromList(doc.GetElementById("instrumentType"), Range("A2").Text)
    Call SelectFromList(doc.GetElementById("symbol"), Range("B2").Text)
    Call SelectFromList(doc.GetElementById("year"), Range("C2").Text)
    Call SelectFromList(doc.GetElementById("expiryDate"), Range("D2").Text)
    Call WaitWeb(IE)
    doc.GetElementById("rdDateToDate").Click
    Call WaitWeb(IE)
    doc.GetElementById("fromDate").Value = Range("E2").Text
    doc.GetElementById("toDate").Value = Range("F2").Text
    doc.GetElementById("getButton").Click
    If WorksheetExists("Sheet2") = False Then Sheets.Add.Name = "Sheet2"
    Call WaitWeb(IE)
    Call TransferData(doc, Sheets("Sheet2"))
    'IE.Quit
    Set IE = Nothing
End Sub[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
Private Sub TransferData(ByRef doc As Object, ByRef inSheet As Object)
Dim Tab1 As Object
Dim Tr As Object
Dim Td As Object
Dim Colstart As Long
Dim i As Long, j As Long, n As Long
   Colstart = 1
   j = 2
   i = Colstart
   n = 0
   'Loop Through website tables
   For Each Tab1 In doc.getElementsByTagName("table")
      With doc.getElementsByTagName("table")(n)
         For Each Tr In .Rows
            For Each Td In Tr.Cells
               inSheet.Cells(j, i) = Td.innerText
               i = i + 1
            Next Td
            i = Colstart
            j = j + 1
          Next Tr
      End With
      n = n + 1
      i = Colstart
      j = j + 1
   Next Tab1
End Sub[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
Private Sub SelectFromList(ByRef objElement As Object, ByVal optionselected As String)
    objElement.Value = optionselected
    objElement.FireEvent "onchange"
    DoEvents
End Sub[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
Private Function WorksheetExists(ByVal WorksheetName As String) As Boolean
Dim Sht As Worksheet
    WorksheetExists = True
    For Each Sht In ActiveWorkbook.Worksheets
        If Sht.Name = WorksheetName Then Exit Function
    Next Sht
    WorksheetExists = False
End Function[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
Private Sub WaitWeb(ByRef IE As Object)
    Do
        DoEvents
    Loop While IE.Busy Or (IE.ReadyState <> 4)
End Sub
[/FONT]
 
Upvote 0
Hi,

I rewiewed the code and i make sure that the Range reference are always from Sheet1

I did several tests and it work fine for me.

Here the new code:

Rich (BB code): 
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Option Explicit
'For ADHWN : Using VBA to submit form and download data
Sub GetFromWeb()
Dim IE As Object
Dim doc As Object
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    IE.Navigate "http://www.nseindia.com/products/content/derivatives/equities/historical_fo.htm"
    Call WaitWeb(IE)
    Application.Wait DateAdd("s", 1, Now)
    Set doc = IE.Document
    With Sheets("Sheet1")
        Call SelectFromList(doc.GetElementById("instrumentType"), .Range("A2").Text)
        Call SelectFromList(doc.GetElementById("symbol"), .Range("B2").Text)
        Call SelectFromList(doc.GetElementById("year"), .Range("C2").Text)
        Call SelectFromList(doc.GetElementById("expiryDate"), .Range("D2").Text)
        doc.GetElementById("rdDateToDate").Click
        doc.GetElementById("fromDate").Value = .Range("E2").Text
        doc.GetElementById("toDate").Value = .Range("F2").Text
        doc.GetElementById("getButton").Click
        If WorksheetExists("Sheet2") = False Then Sheets.Add.Name = "Sheet2"
        Application.Wait DateAdd("s", 1, Now)
        Call WaitWeb(IE)
        Call TransferData(doc, Sheets("Sheet2"))
    End With
    'IE.Quit
    Set IE = Nothing
End Sub[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
Private Sub TransferData(ByRef doc As Object, ByRef inSheet As Object)
Dim Tab1 As Object
Dim Tr As Object
Dim Td As Object
Dim Colstart As Long
Dim i As Long, j As Long, n As Long
   Colstart = 1
   j = 2
   i = Colstart
   n = 0
   'Loop Through website tables
   For Each Tab1 In doc.getElementsByTagName("table")
      With doc.getElementsByTagName("table")(n)
         For Each Tr In .Rows
            For Each Td In Tr.Cells
               inSheet.Cells(j, i) = Td.innerText
               i = i + 1
            Next Td
            i = Colstart
            j = j + 1
          Next Tr
      End With
      n = n + 1
      i = Colstart
      j = j + 1
   Next Tab1
End Sub[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
Private Sub SelectFromList(ByRef objElement As Object, ByVal optionselected As String)
    objElement.Value = optionselected
    objElement.FireEvent "onchange"
    DoEvents
End Sub[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
Private Function WorksheetExists(ByVal WorksheetName As String) As Boolean
Dim Sht As Worksheet
    WorksheetExists = True
    For Each Sht In ActiveWorkbook.Worksheets
        If Sht.Name = WorksheetName Then Exit Function
    Next Sht
    WorksheetExists = False
End Function

[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Private Sub WaitWeb(ByRef IE As Object)
    Do
        DoEvents
    Loop While IE.Busy Or (IE.ReadyState <> 4)
End Sub
[/FONT]
 
Upvote 0
Hi Rino702,

Many thanks for helping out.

I tried it on two different computers and the same issue persists...

Can this be done using Firefox or Chrome?
 
Upvote 0
Hi Adhwn,

It works fine for me, I did test it many times.
I can suggest to increase delay from 1 second to 2 or 3 seconds before the Call TransferData…

For Firefox or Chrome, you will need to install Selenium wrapper (
https://github.com/florentbr/SeleniumBasic), this product is more complex to use that internet explorer ide.

Regards,
Rino
​
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
Modifying Existing VBA Code to add 2 additional data columns
Replies
0
Views
330
keranali
K
A
  • Question Question
code to copy last row & exclude zero value of the data in last row for each name
Replies
0
Views
295
Abdo
A
A
  • Question Question
Using ADODB way t populate data under header from file to another
Replies
0
Views
72
abdo meghari
A
willow1985
  • Solved
Assistance with VBA error handling - a cell not matching data set
2
Replies
10
Views
1K
willow1985
willow1985
RAJESH1960
  • Question Question
VBA code to select the empty cell below the data
Replies
8
Views
3K
MARK858
MARK858

Forum statistics

Threads
1,224,827
Messages
6,181,197
Members
453,021
Latest member
pingpong7117

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top