I'm trying to get the content from a website with VBA, however I keep getting an error.
I already tried several other ways that I looked into similar questions, but nothing seems to work...I also tried with set ie = New InternetExplorer but it didn't work either
Can you help me? My goal is further to find a specific key word and count the number of times it appears.
Thanks,
M
Sub website()
Dim ie As Object
Dim ht As HTMLDocument
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = False
ie.navigate ("https://poetenalinha.pt/2021/01/13/gratinado-de-massa-com-peru-e-legumes/")
Set ht = ie.document --> here is the error!!
Set elems = ht.getElementsByClassName("entry-content")
For Each elem In elems
Debug.Print (elem.innerText)
Next
End Sub
You need to wait until IE fully loaded after navigating to the website. The complete code is like below and works well:
Sub website()
Dim ie As Object
Dim ht As HTMLDocument
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate ("https://poetenalinha.pt/2021/01/13/gratinado-de-massa-com-peru-e-legumes/")
'add this part
Do Until ie.readyState = 4
DoEvents
Loop
Set ht = ie.document
Set elems = ht.getElementsByClassName("entry-content")
For Each elem In elems
Debug.Print (elem.innerText)
Next
End Sub
Result:
This worked for me - for some reason the ie object gets disconnected from the browser instance. If you re-make the connection (using the "GetIE" function) it works.
Sub website()
Dim ie As Object, elems, elem
Dim ht As HTMLDocument
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate "https://poetenalinha.pt/2021/01/13/gratinado-de-massa-com-peru-e-legumes/"
Application.Wait Now + TimeSerial(0, 0, 10) ' wait 10 sec
Set ie = GetIE("https://poetenalinha.pt") ' "reconnect" to IE object
Set ht = ie.document
Set elems = ht.getElementsByClassName("entry-content")
For Each elem In elems
Debug.Print (elem.innerText)
Next
End Sub
'get a reference to an existing IE window, given a partial URL
Function GetIE(sLocation As String) As Object
Dim objShell As Object, objShellWindows As Object, o As Object
Dim sURL As String
Dim retVal As Object
Set retVal = Nothing
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows
For Each o In objShellWindows
sURL = ""
On Error Resume Next 'because may not have a "document" property
'Check the URL and if it's the one you want then
' assign the window object to the return value and exit the loop
sURL = o.document.Location
On Error GoTo 0
If sURL Like sLocation & "*" Then
Set retVal = o
Exit For
End If
Next o
Set GetIE = retVal
End Function
Related
I am testing the code below. I think this is very close, but I can't seem to login to the site for some reason.
Sub Website_Login_Test()
Dim oHTML_Element As IHTMLElement
Dim sURL As String
On Error GoTo Err_Clear
sURL = "https://login.my_site_here.jsp?"
Set oBrowser = New InternetExplorer
oBrowser.Silent = True
oBrowser.timeout = 60
oBrowser.navigate sURL
oBrowser.Visible = True
Do
' Wait till the Browser is loaded
Loop Until oBrowser.readyState = READYSTATE_COMPLETE
Set HTMLDoc = oBrowser.document
For Each oHTML_Element In HTMLDoc
Debug.Print oHTML_Element
Next
HTMLDoc.all.UserId.Value = "my_id"
HTMLDoc.all.Password.Value = "my_pass"
For Each oHTML_Element In HTMLDoc.getElementsByTagName("Button")
Debug.Print oHTML_Element.Name
'oHTML_Element.Click: Exit For
'Debug.Print oHTML_Element.Type
'If oHTML_Element.Type = "submit" Then oHTML_Element.Click: Exit For
Next
' oBrowser.Refresh ' Refresh If Needed
Err_Clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
Call Test
End Sub
Sub Test()
Dim ie As Object, i As Long, strText As String
Dim doc As Object, hTable As Object, hBody As Object, hTR As Object, hTD As Object
Dim tb As Object, bb As Object, tr As Object, td As Object
Dim y As Long, z As Long, wb As Excel.Workbook, ws As Excel.Worksheet
Set wb = Excel.ActiveWorkbook
Set ws = wb.ActiveSheet
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
y = 1 'Column A in Excel
z = 1 'Row 1 in Excel
ie.navigate "https://after_login_move_to_page_for_scraping.jsp"
Do While ie.busy: DoEvents: Loop
Do While ie.readyState <> 4: DoEvents: Loop
Set doc = ie.document
Set hTable = doc.getElementsByTagName("table")
For Each tb In hTable
Set hBody = tb.getElementsByTagName("tbody")
For Each bb In hBody
Set hTR = bb.getElementsByTagName("tr")
For Each tr In hTR
Set hTD = tr.getElementsByTagName("td")
y = 1 ' Resets back to column A
For Each td In hTD
ws.Cells(z, y).Value = td.innertext
y = y + 1
Next td
DoEvents
z = z + 1
Next tr
Exit For
Next bb
Exit For
Next tb
End Sub
I can't login to the site, so I can't do the scraping, but I think the code is pretty close. Here is the HTML for the id object, the password object and the button object. What am I doing wrong?
I think you must trigger the keypress event of the input fields. If there are other events you must trigger, have a look here, how you can find them:
Automate IE via Excel to fill in a dropdown and continue
Sub WebsiteLogin()
Const url As String = "https://login.my_site_here.jsp"
Const userName As String = "Here Your LogIn Name"
Const passWord As String = "Here Your Password"
Dim ie As Object
Dim htmlDoc As Object
Dim nodeInputUserName As Object
Dim nodeInputPassWord As Object
'Initialize Internet Explorer, set visibility,
'call URL and wait until page is fully loaded
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate url
Do Until ie.readyState = 4: DoEvents: Loop
Set htmlDoc = ie.document
'Set the log in name
Set nodeInputUserName = htmlDoc.getElementById("USERID")
nodeInputUserName.Value = userName
Call TriggerEvent(htmlDoc, nodeInputUserName, "onkeypress")
'Set the password
Set nodeInputPassWord = htmlDoc.getElementById("PASSWORD")
nodeInputPassWord.Value = passWord
Call TriggerEvent(htmlDoc, nodeInputPassWord, "onkeypress")
'Click submit button
htmlDoc.querySelector("a[role='button']").Click
End Sub
This is the procedure to trigger events:
Private Sub TriggerEvent(htmlDocument As Object, htmlElementWithEvent As Object, eventType As String)
Dim theEvent As Object
htmlElementWithEvent.Focus
Set theEvent = htmlDocument.createEvent("HTMLEvents")
theEvent.initEvent eventType, True, False
htmlElementWithEvent.dispatchEvent theEvent
End Sub
I am pulling data from NSE site,
the URL is:https://www1.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuoteFO.jsp?underlying=VOLTAS&instrument=FUTSTK&type=-&strike=-&expiry=28MAY2020#
I am successfully extract the item using Internet explorer,How ever this method is slow,
so i moved to MSXML2.XMLHTTP60 method,but this method returns null string
please find my codes
Method 1:Works fine
Sub OI_Slow_Method()
Dim ie As New InternetExplorer
Set ie = CreateObject("InternetExplorer.Application")
Dim Link As String
Link = ActiveSheet.Range("C4").Value
ie.Visible = False
ie.navigate Link
Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE
Dim doc As HTMLDocument
Set doc = ie.document
Dim objElement As HTMLObjectElement
Dim sDD As String
doc.Focus
ActiveSheet.Cells(1, 1).Value = doc.getElementById("openInterest").innerText 'Open Interest Value
ie.Quit
ie.Visible = True
Set doc = Nothing
Set ie = Nothing
End Sub
'--------------------------
Method 2:Help required in this method only
Sub OI_Fast_Method()
Dim xhr As MSXML2.XMLHTTP60, html As MSHTML.HTMLDocument
Set xhr = New MSXML2.XMLHTTP60
Set html = New MSHTML.HTMLDocument
With xhr
.Open "GET", "https://www1.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuoteFO.jsp?underlying=VOLTAS&instrument=FUTSTK&type=-&strike=-&expiry=30APR2020#", False
.send
html.body.innerHTML = StrConv(.responseBody, vbUnicode)
End With
Debug.Print html.getElementById("openInterest").Innertext
'The output of this is "<SPAN id=openInterest>??</SPAN>" only question mark returned inside the SPAN
End Sub
I think Tim hit the nail on the head, as always. You are getting some raw XML and the stuff you want is not in that XML. You can do a data dump and get what you want.
Sub DumpData()
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
URL = "https://www1.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuoteFO.jsp?underlying=VOLTAS&instrument=FUTSTK&type=-&strike=-&expiry=28MAY2020#"
'Wait for site to fully load
ie.Navigate2 URL
Do While ie.Busy = True
DoEvents
Loop
RowCount = 1
With Sheets("Sheet1")
.Cells.ClearContents
RowCount = 1
For Each itm In ie.Document.all
.Range("B" & RowCount) = Left(itm.innerText, 1024)
RowCount = RowCount + 1
Next itm
End With
End Sub
Then you would have to parse the text. It's not hard, but it will be a little extra labor.
Another option may be to download the entire contents of the website, save it as a text file, import the data, and then parse that data.
Sub Sample()
Dim ie As Object
Dim retStr As String
Set ie = CreateObject("internetexplorer.application")
With ie
.Navigate "https://www1.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuoteFO.jsp?underlying=VOLTAS&instrument=FUTSTK&type=-&strike=-&expiry=28MAY2020#"
.Visible = True
End With
Do While ie.readystate <> 4: Wait 5: Loop
DoEvents
retStr = ie.document.body.innerText
'~> Write the above to a text file
Dim filesize As Integer
Dim FlName As String
'~~> Change this to the relevant path
FlName = "C:\Users\ryans\OneDrive\Desktop\Sample.Txt"
filesize = FreeFile()
Open FlName For Output As #filesize
Print #filesize, retStr
Close #filesize
End Sub
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub
I couldn't get either of your code samples to run on my machine.
Need help how to create excel vba code for this
I'll be needing the codes so I can complete my macro.
Thanks in advance
First, you will need to create a reference to:
Microsoft Internet Controls
Microsoft HTML Object Library
In VBE, click Tools > References
Sub clickLink()
Dim ie As New InternetExplorer, Url$, doc As HTMLDocument
Url = "http://UrlToYourLink.com"
With ie
.navigate Url
Do While .Busy Or .readyState < READYSTATE_COMPLETE
DoEvents
Loop
doc = .document
.Visible = True
End With
Dim myBtn As Object
Set myBtn = doc.getElementsByClassName("button rounded")(0)
myBtn.Click
End Sub
The Internet control is used to browse the webpage and the HTML Objects are used to identify the username and password textboxes and submit the text using the control button.
Dim HTMLDoc As HTMLDocument
Dim oBrowser As InternetExplorer
Sub Login_2_Website()
Dim oHTML_Element As IHTMLElement
Dim sURL As String
On Error GoTo Err_Clear
sURL = "https://www.google.com/accounts/Login"
Set oBrowser = New InternetExplorer
oBrowser.Silent = True
oBrowser.timeout = 60
oBrowser.navigate sURL
oBrowser.Visible = True
Do
' Wait till the Browser is loaded
Loop Until oBrowser.readyState = READYSTATE_COMPLETE
Set HTMLDoc = oBrowser.Document
HTMLDoc.all.Email.Value = "sample#vbadud.com"
HTMLDoc.all.passwd.Value = "*****"
For Each oHTML_Element In HTMLDoc.getElementsByTagName("input")
If oHTML_Element.Type = "submit" Then oHTML_Element.Click: Exit For
Next
' oBrowser.Refresh ' Refresh If Needed
Err_Clear:
If Err <> 0 Then
Debug.Assert Err = 0
Err.Clear
Resume Next
End If
End Sub
The program requires references to the following:
1 Microsoft Internet Controls
2. Microsoft HTML Object Library
Microsoft internet controls are a great way to do this, but if you aren't allowed to add new references, here is another way to go about web scraping.
This methode ain't as 'clean' as Microsoft internet controls and HTML object but it gets the job done.
Sub GoogleSearch()
Dim ie As Object
Dim objSearchBnt As Object
Dim objCollection As Object
Dim i As Integer
'initialize counter
i = 0
'Create InternetExplorer Object
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
'navigate to the url
ie.navigate "Www.google.com"
'Statusbar shows in the buttom corner of excel
Application.StatusBar = "Loading, please wait..."
'Wait until page is ready
Do While ie.busy
Application.Wait DateAdd("s", 1, Now)
Loop
'Store all the elements with input tag
Set objCollection = ie.Document.getElementsByTagName("input")
'Go through all input elements
While i < objCollection.Length
'input search field
If objCollection(i).Name = "q" Then
objCollection(i).Value = "Hello World"
End If
'search button
If objCollection(i).Type = "submit" Then
Set objSearchBnt = objCollection(i)
End If
i = i + 1
Wend
objSearchBnt.Click
'Clean up
Set objSearchBnt = Nothing
Set objCollection = Nothing
Set ie = Nothing
'Give excel control over the status bar agian
Application.StatusBar = ""
End Sub
I want to use VBA for taking the URL adress of diferent links from a web page, but without success. Has anyone any idea why my code don't work?
My code is below:
Sub Test()
Dim URL As String
Dim IE As New InternetExplorer
Dim HTMLdoc As HTMLDocument
Dim dictObj As Object: Set dictObj = CreateObject("Scripting.Dictionary")
Dim tRowID As String
URL = "http://www.flashscore.com/soccer/england/premier-league/";
With IE
.Navigate URL
.Visible = True Do Until
.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop Set HTMLdoc = .Document
End With
With HTMLdoc
Set tblSet = .getElementById("fs-results")
Set mTbl = tblSet.getElementsByTagName("tbody")(1)
Set tRows = mTbl.getElementsByTagName("tr")
With dictObj
For Each tRow In tRows
tRowID = Mid(tRow.getAttribute("id"), 5)
If Not .Exists(tRowID) Then .Add tRowID, Empty
End If
Next tRow
End With
End With
For Each Key In dictObj
Debug.Print Key
Next Key
Set IE = Nothing
End Sub
I'm trying to get month-to-date and year-to-date return values from the website
http://us.spindices.com/indices/equity/sp-oil-gas-exploration-production-select-industry-index
into an Excel spreadsheet using VBA. The problem is that there is no "id= " in the code of the page, which I understand would make this process a lot simpler. There is also the matter of which time period (year-to-date or month-to-date) is visible, but I'd be happy with scraping just the MTD values for now.
Here is my code:
Sub Get_Change()
'attempting to scrape Barclay's website
Dim appIE As Object
Dim MyVar As String
Set appIE = CreateObject("internetexplorer.application")
With appIE
.Navigate "http://us.spindices.com/indices/equity/sp-oil-gas-exploration-production-select-industry-index"
.Visible = True
End With
Do While appIE.Busy
DoEvents
Range("A1").Value = "Working..."
Loop
Set TDelements = appIE.document.getElementsbyClassName("performance-chart-table")
For Each TDelement In TDelements
If TDelement.class = "change" Then
MyVar = TDelement.class.innerText("Value")
End If
Next
Range("A1").Value = MyVar
appIE.Quit
Set appIE = Nothing
End Sub
If I can get a way to set the 'MyVar' variable to the current MTD or YTD value, I'll be done, but I'm having a hard time since there is not a unique identifier for either of these values. Any ideas?
I've recently watched some CSS training videos and I can tell you the CSS selector syntax is powerful and I'd recommend it. This is the same syntax that javascript/web developers use to select elements when using JQuery.
I think you should try using
document.queryselectorall
or in your case because you have drilled in to the document to get the "performance-chart-table" call queryselectorall off of that variable, TDelements.
Documentation at http://www.w3schools.com/jsref/met_document_queryselectorall.asp
and you supply as a parameter a CSS selector string the syntax of which can be found at http://www.w3schools.com/cssref/css_selectors.asp
And I've gone and done it for you....
Sub Get_Change()
'* Tools-References Microsoft HTML Object Library
'attempting to scrape Barclay's website
Dim appIE As Object
Dim MyVar As String
Set appIE = CreateObject("internetexplorer.application")
With appIE
.Navigate "http://us.spindices.com/indices/equity/sp-oil-gas-exploration-production-select-industry-index"
.Visible = True
End With
Do While appIE.Busy
DoEvents
Range("A1").Value = "Working..."
Loop
Dim htmlDoc As MSHTML.HTMLDocument
Set htmlDoc = appIE.document
Dim TDelements2 As MSHTML.IHTMLElementCollection
Set TDelements2 = htmlDoc.getElementsByClassName("performance-chart-table")
While TDelements2.Length < 1
DoEvents
Application.Wait (Now() + TimeSerial(0, 0, 3))
Set TDelements2 = htmlDoc.getElementsByClassName("performance-chart-table")
Wend
Dim oHTMLTablePerformanceChartTable As MSHTML.HTMLTable
Set oHTMLTablePerformanceChartTable = TDelements2.Item(0)
Dim objChangeCollection As MSHTML.IHTMLDOMChildrenCollection
Set objChangeCollection = oHTMLTablePerformanceChartTable.querySelectorAll(".change")
'Debug.Assert objChangeCollection.Length = 2
Dim objChange2 As Object
Set objChange2 = objChangeCollection.Item(1)
MyVar = objChange2.innerText
'Set TDelements = appIE.document.getElementsByClassName("performance-chart-table")
'
'For Each TDelement In TDelements
' TDelements.querySelectorAll (".change")
' If TDelement.class = "change" Then
' MyVar = TDelement.class.innerText("Value")
'
' End If
'Next
Range("A1").Value = MyVar
appIE.Quit
Set appIE = Nothing
End Sub