VBA Code to Fetch details from website- Data Scraping

[Murali_K]

Hi Guys,

i am trying to automate fetching data from a Internal website using VBA. i Have serial numbers in Col A and want to populate results in Col B respectively.

I have Below VBA code.

Sub datascrape()Dim IE As Object
Dim Doc As HTMLDocument
Dim foo As Object, myStr As String
'Set foo = objIE.Document.getElementsByClassName("Message")(0).getElementsByTagName("a")(0)
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.navigate "URL"
Do While IE.Busy Or IE.ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop
Set Doc = IE.Document
For rowNo = 1 To 5
Doc.getElementById("txtField1").Value = ThisWorkbook.Sheets("Sheet1").Range("A" & rowNo).Value
Doc.getElementById("CtrlQuickSearch1_imgBtnSumbit").Click
Do While IE.Busy Or IE.ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop
strVal = Doc.getElementsByClassName("tlc_node_text")(0).innerText
ThisWorkbook.Sheets("Sheet1").Range("B" & rowNo).Value = strVal
Next
End Sub





<div class="tlc_node_text" style="left: 0px; width: 200px;"><span><img width="16" height="16" align="absmiddle" style="cursor: hand;" onclick="TreeListControlHandler.callCollapse(0,2);" onmouseenter="TreeListControlHandler.preventRowClick=true;" onmouseleave="TreeListControlHandler.preventRowClick=false;" src="images/handle.collapse.end.gif"><img width="16" height="16" align="absmiddle" src="images/pcbicon.jpg"></span>&nbsp;<span><a style="color: green;" href="rpUUT_HistoryData.aspx?SN=FOC1904U00Z">FOC1904U00Z</a></span></div>

i want to fetch the value FOC1904U00Z in the last from "<span><a style="color: green;" href="rpUUT_HistoryData.aspx?SN=FOC1904U00Z">FOC1904U00Z</a></span>" element.
i tried strVal = Doc.getElementsByClassName("tlc_node_text")(0).getElementsByTagName("a")(0).innerText
but this is returnig VBA error.

can some one help me to resolve this?

Note-the website is Intranet and need credentials. hence not sharing website info.

Thanks in advance

[Leith Ross]

Hello Murali_K,

I find it easier to assign key HTML elements to VBA objects. It makes the code easier to read and to follow. Since you know that the DIV is first one with the class name "tlc_node_text" and that the Div has 2 children SPAN(0) and SPAN(1), you can get the inner text from the Child Node of Span(1) which is the anchor element. This worked in my testing...



Dim oDiv As Object
Dim Text As String

Set oDiv = Doc.GetElementsByTagName("div")(0)
Text = oDiv.GetElementsByTagName("span")(1).Children(0).innerText


ThisWorkbook.Sheets("Sheet1").Range("B" & rowNo).Value = Text

[Murali_K]

Hi Leith,

Thanks for the replay. i did tried your code. i am getting Runtime Error "91" (Object Varialble OrWith Block Variable Not set)
on "Text = oDiv.GetElementsByTagName("span")(1).Children(0).innerText". how to over come this?


Hello Murali_K,

I find it easier to assign key HTML elements to VBA objects. It makes the code easier to read and to follow. Since you know that the DIV is first one with the class name "tlc_node_text" and that the Div has 2 children SPAN(0) and SPAN(1), you can get the inner text from the Child Node of Span(1) which is the anchor element. This worked in my testing...



Dim oDiv As Object
Dim Text As String

Set oDiv = Doc.GetElementsByTagName("div")(0)
Text = oDiv.GetElementsByTagName("span")(1).Children(0).innerText


ThisWorkbook.Sheets("Sheet1").Range("B" & rowNo).Value = Text

[Leith Ross]

Hello Murali_K,That tells me that oDiv may be set to Nothing meaning the DIV element was not found. Add a break point on the line "Text =oDiv.GetElementsByTagName...". To add a break point, place your cursor anywhere on the line and press F9. To remove it press F9 again. Let me know what you find.

[Murali_K]

Hi Leith,

the below code works fine for me but it take some time. is there any way to make this code to work fast?

Sub CMRCTool()Dim IE As Object
Dim Doc As HTMLDocument
Dim myStr As String
'On Error GoTo 0
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False


IE.navigate "URL"
Do While IE.Busy Or IE.ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop
Set Doc = IE.Document
Doc.getElementById("tbxUserID").Value = InputBox("Please Enter Your ID")
Doc.getElementById("txtPassword").Value = InputBox("Please Enter Your Password")
Doc.getElementById("BtnLogin").Click
Do While IE.Busy Or IE.ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop
IE.navigate "URL"
Do While IE.Busy Or IE.ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop
Dim LastRow As Long
Set wks = ActiveSheet
LastRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
Set rowNo = wks.Range("A1:A" & LastRow)
For rowNo = 2 To LastRow
Doc.getElementById("txtField1").Value = ThisWorkbook.Sheets("Sheet1").Range("A" & rowNo).Value
Doc.getElementById("CtrlQuickSearch1_imgBtnSumbit").Click
Do While IE.Busy Or IE.ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop
strVal1 = Doc.querySelectorAll("span")(33).innerText
ThisWorkbook.Sheets("Sheet1").Range("B" & rowNo).Value = strVal1
strVal2 = Doc.querySelectorAll("span")(35).innerText
ThisWorkbook.Sheets("Sheet1").Range("C" & rowNo).Value = strVal2
Next
MsgBox " Done with Fetching Parent SN and PID"
End Sub


Hello Murali_K,That tells me that oDiv may be set to Nothing meaning the DIV element was not found. Add a break point on the line "Text =oDiv.GetElementsByTagName...". To add a break point, place your cursor anywhere on the line and press F9. To remove it press F9 again. Let me know what you find.