We Keep Coding

Web Scraping by VBA for JavaScript Content Webpage - javascript

I am trying to extract a table from Drainage Services Department. I have wrote below VBA code, but it does not work. I guess the reason is because this table is JavaScript. Any idea to solve this problem?
Sub DSD()
Dim ie As New InternetExplorer
Dim html As New HTMLDocument
Dim url As String
url = "https://www.dsd.gov.hk/EN/Tender_Notices/Current_Tenders/index.html"
ie.Visible = False
ie.navigate url
Do While ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
Set html = ie.document
Dim lists As IHTMLElementCollection
Dim anchorElements As IHTMLElementCollection
Dim ulElement As HTMLUListElement
Dim liElement As HTMLLIElement
Dim row As Long
Set lists = html.getElementsByClassName("ncol-md-12 result")
row = 1
For Each ulElement In lists
For Each liElement In ulElement.getElementsByTagName("tbody")
Set anchorElements = liElement.getElementsByTagName("td")
If anchorElements.Length > 0 Then
Cells(row, 1) = anchorElements.Item(0).innerText
row = row + 1
End If
Next liElement
Next ulElement
ie.Quit
End Sub
I am trying to scrape the table from this website.

UPDATE
Try this instead. I simply gave it some time to load everything into the lists object that you have set up and that did the trick.
Sub DSD()
Dim ie As New InternetExplorer
Dim html As New HTMLDocument
Dim url As String
url = "https://www.dsd.gov.hk/EN/Tender_Notices/Current_Tenders/index.html"
ie.Visible = False
ie.navigate url
Do While ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
Set html = ie.document
Dim lists As IHTMLElementCollection
Dim anchorElements As IHTMLElementCollection
Dim ulElement As HTMLUListElement
Dim liElement As HTMLLIElement
Dim row As Long
'you had put "ncol-md-12 result" it is actually named "col-md-12 result"
Set lists = html.getElementsByClassName("col-md-12 result")
row = 1
''application needs time to load everything into lists.
Application.Wait (Now + TimeValue("00:00:01"))
''or with a loop
''Do While i < 1000
''DoEvents
''i = i + 1
''Loop
For Each ulElement In lists
For Each liElement In ulElement.getElementsByTagName("tbody")
Set anchorElements = liElement.getElementsByTagName("td")
If anchorElements.Length > 0 Then
Debug.Print anchorElements.Item(0).innerText
Cells(row, 1) = anchorElements.Item(0).innerText
row = row + 1
End If
Next liElement
Next ulElement
ie.Quit
End Sub

Related

The HTML code looks like this. The button says "Open in Excel" that needs to be clicked. Once clicked, it downloads a csv file.
<div class="analyze-view-nav-bar"><div class="analyze-view-nav-bar-left-button-container"><button title="View results" class="analyze-view-nav-button office-form-theme-button button-control light-background-button"><div class="button-content">View results</div></button></div><div class="analyze-view-export-to-excel-button"><div><button title="Open in Excel" class="analyze-view-export-button-container glyph-button-control-horizontal button-control light-background-button" aria-label="Open in Excel"><div class="button-content"><i class="ms-Icon ms-Icon--ExcelLogo forms-icon-size24x24" role="presentation" aria-hidden="true"></i><span class="analyze-view-export-button-label">Open in Excel</span></div></button></div></div></div>
this is the VBA
Sub test()
Dim ie As InternetExplorer
Dim doc As HTMLDocument
Dim frm As HTMLFrameElement
Dim frms As HTMLElementCollection
Dim strSQL As String
strSQL = "https://forms.office.com/Pages/DesignPage.aspx#Analysis=true&FormId=AY3zc5go1USqcDdJLNPiTh0SDUMn3HlMvKv7KoZTC9VUN1FIWUtSREM3RVFUQjRTWUczMlNPM09CTC4u&Token=be26006342a64df49e7dafb25915c140"
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.navigate strSQL
Do Until .readyState <> READYSTATE_COMPLETE: DoEvents: Loop
'Set doc = IE.document
ie.document.all("Open in Excel").Click
End With
End Sub

You can use an attribute = value selector (assuming not in parent iframe/frame. You can thus target the button by its title attribute value. Otherwise, you need to negotiate the parent iframe/frame.
ie.document.querySelector("[title='Open in Excel']").click
Use a proper page load wait as well
While ie.Busy Or ie.readyState < 4: DoEvents: Wend

When i go to fatch data using (from date) to (to date), click on show button using vba not working
Also i need suggestion, How can i download csv file from multiple dates
i wanted to download csv file for each date between date range
Dim MP, FD, TD As String
MP = ActiveWorkbook.Name
FD = Sheets("Sheet1").Range("XFA2")
TD = Sheets("Sheet1").Range("XFB2")
Dim IE As New SHDocVw.internetexplorer
Dim HTMLDoc As MSHTML.HTMLDocument
IE.Visible = True
IE.navigate "https://www.mcxindia.com/market-data/bhavcopy"
ShowWindow IE.hwnd, SW_SHOWMAXIMIZED
Do While IE.readyState <> READYSTATE_COMPLETE
Loop
Set HTMLDoc = IE.document
For N = FD To TD
Workbooks(MP).Worksheets("Sheet1").Range("XEX2").Value = (FD)
N1 = Workbooks(MP).Worksheets("Sheet1").Range("XEX3").Value
HTMLDoc.getElementById("txtDate").Value = (N1)
HTMLDoc.getElementById("btnShowDatewise").Click
Next N
Suggest me the codes to click on submit button and how to download multiple date files,since show button takes time to publish data and then i could click on csv tab on rightside penal of webpage

If you are only setting the one day you can do the following which includes a check that the date produces a download file
Option Explicit
Public Sub Download()
Dim ie As New InternetExplorer
With ie
.Visible = True
.Navigate2 "https://www.mcxindia.com/market-data/bhavcopy"
While .Busy Or .readyState < 4: DoEvents: Wend
With .document
.parentWindow.execScript "document.querySelector('#cph_InnerContainerRight_C001_txtDate_hid_val').value='20190201';"
.parentWindow.execScript "document.querySelector('#txtDate').value='20190201';"
.querySelector("#btnShowDatewise").Click
If .querySelectorAll("#cph_InnerContainerRight_C001_lnkExpToCSV").Length > 0 Then
.parentWindow.execScript "__doPostBack('ctl00$cph_InnerContainerRight$C001$lnkExpToCSV','');"
End If
End With
While .Busy Or .readyState < 4: DoEvents: Wend
'.Quit
End With
End Sub

I am attempting to automate a certain process for my business by clicking on certain links on a webpage, inputting business data into a search box and compare it with existing data. I am however, unsuccessful at clicking a javascript based link which also the part of the table using VBA. The website's relevant HTML is as below,
<tr class="odd"> <td> <a onclick="viewCompanyDetails('B214273', '1529481460070');" href="javascript:;">Alinda Infrastructure Fund III (Euro) GP SARL</a></td> <td><a onclick="viewCompanyDetails('B214273', '1529481460070');" href="javascript:;">B214273</a></td> </tr>
Here is my poor attempt at doing the project,
Private Sub CommandButton1_Click()
Set IE = CreateObject("InternetExplorer.Application")
my_url = "https://www.lbr.lu/mjrcs/jsp/DisplayConsultDocumentsActionNotSecured.action?FROM_MENU=true&time=1528967707649&currentMenuLabel=menu.item.companyconsultation"
consoletext = consoletext & "Connection established to Luxembourg Business Registers on www.rcsl.lu via Internet Explorer..." & vbNewLine & vbNewLine
txtConsole.Value = consoletext
consoletext = consoletext & "Looking up Registre De Commerce et des Societes." & vbNewLine & vbNewLine
txtConsole.Value = consoletext
With IE
.Visible = True
.navigate my_url
Do Until Not IE.Busy And IE.readyState = 4
DoEvents
Loop
End With
For Each objlink In IE.document.getElementsByTagName("href")
If objlink.href = "/mjrcs/jsp/DisplayConsultDocumentsActionNotSecured.action?FROM_MENU=true&time=1528969484260&currentMenuLabel=menu.item.companyconsultation" Then
objlink.Click
Exit For
End If
Next objlink
Do Until Not IE.Busy And IE.readyState = 4
DoEvents
Loop
consoletext = consoletext & "Looking up " & Sheets("Results").Range("N1").Value & " in the registry." & vbNewLine & vbNewLine
txtConsole.Value = consoletext
Dim TradeName As String
TradeName = ThisWorkbook.Sheets("Results").Range("Y1").Value
IE.document.getElementById("companyName").Value = TradeName
Set objSubmit = IE.document.getElementsByTagName("input")
For Each btn In objSubmit
If btn.Value Like "Search" Then
btn.Click
End If
Next
Do Until Not IE.Busy And IE.readyState = 4
DoEvents
Loop
For Each entitylink In IE.document.getElementsByClassName("tr")
If entitylink.getElementsByTagName = "a" And entitylink.textcontent = Sheets("Results").Range("N1").Value And entitylink.href = "javascript:;" Then
entitylink.Click
Exit For
End If
Next entitylink
txtXMLpath.Value = ""
End Sub
This is what the webpage content looks like,
enter image description here
I have hidden the name of the entity to protect the identity of the client. I need to click the result on the first row per the image.
I will be much obliged if you could provide any help. Again, I'm a beginner in VBA and have no idea how to proceed here. Please let me know should you require further clarification

You can use .querySelector to get the element you want which is the first with
.document.querySelector("a[onclick='viewCompanyDetails('B214273', '1529481460070');']")
Then you may need to do either:
.document.querySelector("a[onclick='viewCompanyDetails('B214273', '1529481460070');']").Click
or
.document.querySelector("a[onclick='viewCompanyDetails('B214273', '1529481460070');']").fireEvent 'onclick'
CSS selector:
The selector returns 2 items from your HTML but .querySelector will only return the first of these when applying the selector to the HTML. The first is the required "SARL".
More info on .fireEvent method:
fireEvent method: Fires a specified event on the object.
Syntax: object.fireEvent(bstrEventName, pvarEventObject,
pfCancelled)
It has a boolean return value which if TRUE tells you the event was successfully fired.
.querySelector method:
The Document method querySelector() returns the first Element
within the document that matches the specified selector, or group of
selectors. If no matches are found, null is returned.
Syntax: element = document.querySelector(selectors); <== note the ";"
is not used in VBA
Edit:
If .querySelector method is not supported you could try looping the a tags and clicking when a particular string is found e.g.
Dim c As Object, n As Object
Set c = ie.document.getElementsByTagName("a")
For Each n In c
If InStr(1, n.innerText, "Alinda Infrastructure Fund III (Euro) GP SARL") > 0 Then
n.Click
Exit For
End If
Next n
Without more HTML to target the specific a tags of interest you can do a general write out of all a tags with:
Dim c As Object, n As Object, counter As Long
Set c = ie.document.getElementsByTagName("a")
With ActiveSheet
For Each n In c
counter = counter + 1
.Cells(counter, 1) = n.innerText
Next n
End With
More HTML is needed to target this better; perhaps there is a className or Id to identify the element housing these a tags?
For your link to write table to sheet:
Option Explicit
Public Sub GetInfo()
Dim ie As Object
Application.ScreenUpdating = False
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.navigate "https://www.lbr.lu/mjrcs"
While .Busy Or .readyState < 4: DoEvents: Wend '<== Loop until loaded
Dim links As Object, link As Object
Set links = .document.getElementsByTagName("a")
For Each link In links
If link.innerText = "View the person's file" Then
link.Click
Exit For
End If
Next link
While .Busy Or .readyState < 4: DoEvents: Wend
.document.getElementById("companyName").innerText = "Alinda"
.document.getElementsByClassName("button")(0).Click
While .Busy Or .readyState < 4: DoEvents: Wend
Dim hTable As HTMLTable
Set hTable = .document.getElementsByClassName("commonTable")(0)
Dim n As Object, tRow As Object, tCell As Object, tr As Object, td As Object, r As Long, c As Long, hBody As Object
r = 1
With ActiveSheet
Set hBody = hTable.getElementsByTagName("tbody")
For Each n In hBody 'HTMLTableSection
Set tRow = n.getElementsByTagName("tr") 'HTMLTableRow
For Each tr In tRow
Set tCell = tr.getElementsByTagName("td")
c = 1
For Each td In tCell 'DispHTMLElementCollection
.Cells(r, c).Value = td.innerText 'HTMLTableCell
c = c + 1
Next td
r = r + 1
Next tr
Next n
End With
.Quit '<== Remember to quit application
End With
Application.ScreenUpdating = True
End Sub

I have been trying to write excel VBA code that clicks on an image that has been placed in an HTML Table. The image which I am trying to click has only the source code.
I Tried in 4 different ways to click the image, but none of these worked. Can anyone please help me how to write VBA code?
1.
Dim HTMLDoc As Object
Set HTMLDoc = IE.document
Dim ElementCol As Object
Set ElementCol = HTMLDoc.getElementsByTagName("td")
For Each link In ElementCol
If link.innerHTML = "excel.jpg" Then
link.Click
Exit For
End If
Next link
2.
Dim HTMLDoc As Object
Set HTMLDoc = IE.document
Dim i As Object
For Each i In HTMLDoc.images
If i.src = "../images/excel.jpg" Then
i.Click
Exit for
End If
Next i
3.
Dim HTMLDoc As Object
Set HTMLDoc = IE.document
Dim img As Object
For Each img In HTMLDoc.all
If img.innerHTML = "excel.jpg" Then
img.Click
Exit For
End If
Next img
4.
Dim HTMLDoc As Object
Set HTMLDoc = site.document
Dim tdCollection As Object
Set tdCollection = HTMLDoc.all
For Each cell In tdCollection
If cell.ID = "singleXLS" Then
cell.Click
Exit Sub
End If
Next
Here is the HTML code.
<tbody><tr>
<td id="singleXLS" onclick="javascript:gCognosViewer.getRV().viewReport('spreadsheetML');" return="" true;"="" style="cursor:hand;" valign="middle" align="center">
<img src="../images/excel.jpg" border="0"></td>
<td> </td>
As suggested, here is the code I am using.
Sub click_img()
Dim URL As String
Dim HTMLDoc As Object
Set site = CreateObject("internetexplorer.application")
URL = Range("B2").Value 'There is an URL in cell B2
site.navigate URL
site.Visible = True
While site.busy
Wend
Do Until site.readyState = 4
DoEvents
Loop
Set HTMLDoc = site.Document
HTMLDoc.getElementById("singleXLS").getElementsByTagName("img")(0).Click 'Error is here
End Sub

Instead of this:
Set HTMLDoc = site.Document
HTMLDoc.getElementById("singleXLS").getElementsByTagName("img")(0).Click
Try:
Dim s, i
Set HTMLDoc = site.Document
Set s = HTMLDoc.getElementById("singleXLS")
If Not s Is Nothing Then
Set i = s.getElementsByTagName("img")(0)
If Not i Is Nothing Then
i.Click
Else
Debug.Print "Img not found!"
End If
Else
Debug.Print "singleXLX not found!"
End If
A lot more code, but it will help you pin down the exact problem

This is my first try to navigate a IE browser through VBA.
I am trying to:
- go to this webpage https://hb2.bankleumi.co.il/e/Login.html
- fill in the username
- fill the password
- click the "login" button
for now I'm getting the error "Method 'Document' of object 'IWebBrowser2' failed"
I tried to inspect the elements in the html code of the webpage and found their ids but I suppose I'm making some mistake in invoking the methods or approaching the object.
my code is:
Option Explicit
Sub dataFromLeumi()
Dim myPassword As String
myPassword = "somepassword"
Dim myUserName As String
myUserName = "someusername"
Dim loginPath As String
loginPath = "https://hb2.bankleumi.co.il/e/Login.html"
Dim IE As Object
Set IE = CreateObject("InternetExplorer.application")
IE.Visible = True
IE.navigate loginPath
Dim userName As Object
Set userName = IE.document.getattribute("uid")
userName.Item(0).Value = myUserName
Dim password As Object
password = IE.document.getelementbyid("password")
password.Item(0).Value = myPassword
IE.document.getelementbyid("enter").Click
End Sub
What should I change in my code? What do I miss out?
Thanks!

Try this
Sub test()
' open IE, navigate to the desired page and loop until fully loaded
Set ie = CreateObject("InternetExplorer.Application")
my_url = "https://hb2.bankleumi.co.il/e/Login.html"
With ie
.Visible = True
.Navigate my_url
.Top = 50
.Left = 530
.Height = 400
.Width = 400
Do Until Not ie.Busy And ie.readyState = 4
DoEvents
Loop
End With
' Input the userid and password
ie.Document.getElementById("uid").Value = "testID"
ie.Document.getElementById("password").Value = "testPW"
' Click the "Search" button
ie.Document.getElementById("enter").Click
Do Until Not ie.Busy And ie.readyState = 4
DoEvents
Loop
End Sub