I created the following program to extract data from website to excel sheet but it's showing error.
Error line:
price = html.getElementById("azimuth").Item(0).innerText"
Error message:
Run Time Error '91': with Object Variable or block variable not set
Novice in VBA.
Sub Get_Web_Data()
Dim request As Object
Dim response As String
Dim html As New HTMLDocument
Dim website As String
Dim price As Variant
website = "https://www.mooncalc.org/#/40.7146,-74.0071,9/2022.04.15/18:30/1/3"
Set request = CreateObject("MSXML2.XMLHTTP")
[enter image description here][1]
request.Open "GET", website, False
request.send
response = StrConv(request.responseBody, vbUnicode)
html.body.innerHTML = response
price = html.getElementById("azimuth").Item(0).innerText
Cells(2, "B") = price
End Sub
Related
I am trying to get Addresses Data from URL but facing some error. I am just beginner in VBA, i did not Understand where is problem in my code. wish somebody can help me to get right solution.
here I attached Image and also my VBA code
here is my Code
Public Sub IE_GetLink()
Dim sResponse As String, HTML As HTMLDocument
Dim url As String
Dim Re As Object
Set HTML = New HTMLDocument
Set Re = CreateObject("MSXML2.XMLHTTP")
'On Error Resume Next
url = "http://markexpress.co.in/network1.aspx?Center=360370&Tmp=1656224682265"
With Re
.Open "GET", url, False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
sResponse = StrConv(.responseBody, vbUnicode)
End With
Dim Title As Object
With HTML
.body.innerHTML = sResponse
Title = .querySelectorAll("#colspan")(0).innerText
End With
MsgBox Title
End Sub
Please help me ...
Several things.
What is wrong with your code:
Title should be a string as you are attempting to assign the return of .innerText to it. You have declared it as an object which would require SET keyword (and the removal of the .innerText accessor).
Colspan is an attribute not an id so your css selector list is incorrect.
Furthermore, looking at what the page actually does, there is a request for an additional document which actually has the info you need. You need to take the centre ID you already have and change the URI you make a request to.
Then, you want only the first td in the target table. Change your CSS selector list to target that.
Public Sub GetInfo()
Dim HTML As MSHTML.HTMLDocument
Dim re As Object
Set HTML = New MSHTML.HTMLDocument
Set re = CreateObject("MSXML2.XMLHTTP")
Dim url As String
Dim response As String
url = "http://crm.markerp.in/NetworkDetail.aspx?Center=360370&Tmp="
With re
.Open "GET", url, False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
response = .responseText
End With
Dim info As String
With HTML
.body.innerHTML = response
info = .querySelector("#tblDisp td").innerText
End With
MsgBox info
End Sub
I am getting a problem to scroll document in a proper position, also getting a problem to capture a proper detail in excel here is my Code please Sir suggest me where I am getting wrong
here i try with following code still getting some error
Public Sub GData()
'On Error Resume Next
Dim html As HTMLDocument
Dim Re, Cr, cipherDict As Object
Dim sResponse, cipherKey, Str, SG As String
Dim myArr, RsltArr(14) As Variant
Set Re = CreateObject("vbscript.regexp")
Set Cr = CreateObject("MSXML2.XMLHTTP")
Set cipherDict = CreateObject("Scripting.Dictionary")
Set html = New HTMLDocument
URL = "https://www.google.com/maps/place/Silky+Beauty+Salon/#22.2932632,70.7723656,17z/data=!3m1!4b1!4m5!3m4!1s0x3959ca1278f4820b:0x44e998d30e14a58c!8m2!3d22.2932632!4d70.7745543"
With Cr
.Open "GET", URL, False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
sResponse = StrConv(.responseBody, vbUnicode)
s = .responseText
End With
With html
.body.innerHTML = sResponse
title = .querySelector("section-hero-header-title-title").innerText
phone = .querySelector("[data-item-id^=phone] [jsan*=text]").innerText
webSite = .querySelector("[aria-label^=Website] [jsan*=text]").innerText
End With
datarw = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row + 1
ActiveSheet.Cells(datarw, 1).Value = title
ActiveSheet.Cells(datarw, 5).Value = phone
ActiveSheet.Cells(datarw, 7).Value = webSite
ActiveSheet.Cells(datarw, 1).Select
ActiveSheet.Rows(datarw).WrapText = False
End Sub
Looks like you can use combinations of different combinators (^ starts with and * contains) to search for substrings in attributes on the page to get your target nodes. Using descendant combinators to specify the relationship between attributes being used for anchoring.
Test if matched node Is Not Nothing before attempting to access either an attribute value or .innerText
Dim phone as Object, webSite As Object, title As Object
Set title = ie.document.querySelector(".section-hero-header-title-title")
Set phone = ie.document.querySelector("[data-item-id^=phone] [jsan*=text]")
Set website = ie.document.querySelector("[aria-label^=Website] [jsan*=text]")
If Not phone Is Nothing Then
'clean phone.innerText as appropriate
End If
If Not website Is Nothing Then
'clean website.innerText as appropriate
End If
To get the appropriate protocol for the website address, if missing, you can use the cleaned website address you have in a regex to pull the protocol from earlier in the html where it sits in a script tag.
Read about
css selectors: https://developer.mozilla.org/en-US/docs/Web/CSS/CSS_Selectors
querySelector: querySelector and querySelectorAll vs getElementsByClassName and getElementById in JavaScript
I have a report in access that gets an image from a url when charged, for this purpose I use MSXML2.ServerXMLHTTP to get the url.
Here is the code used:
Dim sURL As String
Dim v As Variant
v = Split(sURL, "/")(UBound(Split(sURL, "/")))
Dim obj As Object
Dim fl() As Byte
Set obj = CreateObject("MSXML2.ServerXMLHTTP")
With obj
.Open "GET", sURL, False
.Send
fl = .Responsebody
End With
The problem I have is when in the execution arrives to the .send it exits from the method despite having some more code, giving me no errors but also not displaying the image in the report.
Do you know what may be the cause?
Thank you in advance.
I've written a script in vba to get some set names from a webpage and the script is getting them accordingly until it catches an error somewhere within the execution. This is the first time I encountered such error.
What my script is doing is get all the links under Company Sets and then tracking down each of the links it goes one layer deep and then following all the links under Set Name it goes another layer deep and finally parse the table from there. I parsed the name of PUBLISHED SET which is stored within the variable bName instead of the table as the script is getting bigger. I used IE to get the PUBLISHED SET as there are few leads which were causing encoding issues.
I searched through all the places to find any workaround but no luck.
However, I came across this thread where there is a proposed solution written in vb but can't figure out how can I make it work within vba.
Script I'm trying with:
Sub FetchRecords()
Const baseUrl$ = "https://www.psacard.com"
Const link = "https://www.psacard.com/psasetregistry/baseball/company-sets/16"
Dim IE As New InternetExplorer, Htmldoc As HTMLDocument
Dim Http As New XMLHTTP60, Html As New HTMLDocument, bName$, tRow As Object
Dim post As Object, elem As Object, posts As Object, I&, R&, C&
Dim key As Variant
Dim idic As Object: Set idic = CreateObject("Scripting.Dictionary")
With Http
.Open "GET", link, False
.send
Html.body.innerHTML = .responseText
End With
Set posts = Html.querySelectorAll(".dataTable tr td a[href*='/psasetregistry/baseball/company-sets/']")
For I = 0 To posts.Length - 7
idic(baseUrl & Split(posts(I).getAttribute("href"), "about:")(1)) = 1
Next I
For Each key In idic.Keys
With Http
.Open "GET", key, False
.send
Html.body.innerHTML = .responseText
End With
For Each post In Html.getElementsByTagName("a")
If InStr(post.getAttribute("title"), "Contact User") > 0 Then
If InStr(post.ParentNode.getElementsByTagName("a")(0).getAttribute("href"), "publishedset") > 0 Then
IE.Visible = True
IE.navigate baseUrl & Split(post.ParentNode.getElementsByTagName("a")(0).getAttribute("href"), "about:")(1)
While IE.Busy = True Or IE.readyState < 4: DoEvents: Wend
Set Htmldoc = IE.document
bName = Htmldoc.querySelector("h1 b.text-primary").innerText
If InStr(bName, "/") > 0 Then bName = Split(Htmldoc.querySelector(".inline-block a[href*='/contactuser/']").innerText, " ")(1)
R = R + 1: Cells(R, 1) = bName
End If
End If
Next post
Next key
IE.Quit
End Sub
I get that error pointing at the following line after extracting records between 70 to 90:
bName = Htmldoc.querySelector("h1 b.text-primary").innerText
The error looks like:
Automation Error: old format or invalid type library
Proposed solution in the linked thread written in vb (can't convert to vba):
'save the current settings for easier restoration later
Dim oldCI As System.Globalization.CultureInfo = _
System.Threading.Thread.CurrentThread.CurrentCulture
'change the settings
System.Threading.Thread.CurrentThread.CurrentCulture = _
New System.Globalization.CultureInfo("en-US")
Your code here
'restore the previous settings
System.Threading.Thread.CurrentThread.CurrentCulture = oldCI
I'm trying to create my own ticker price. Now I'm trying to get the ticker prices for indexes and trust funds which complicates things. I want to access the ticker price for the following url: https://www.avanza.se/fonder/om-fonden.html/313047/norron-active-r
Now the issue is getting to the 180,05 ( under "NAV-kurs" ) ticket price which is under the HTML class"SText bold" ( right-clicking price and selecting view component ).
I can do individual stocks through yahoo finance through getelementbyid but how do I access the innertext for a HTML-class? I can't find any property that works in connection to getelementbyclassname which I tried.
Code below
Private Sub get_ticker()
Dim ie_app As InternetExplorer
Dim ie_doc As htmldocument
Dim ticker As String
Set ie_app = CreateObject("internetexplorer.application")
ie_app.Visible = True
ie_app.navigate ("https://www.avanza.se/fonder/om-fonden.html/313047/norron-active-r")
Do Until ie_app.readyState = READYSTATE_COMPLETE
DoEvents
Loop
Set ie_doc = ie_app.document
ticker = ie_doc.getelement <<---- gaah
Debug.Print ticker
End Sub
If you are reluctant to use Javascript at all you can try something like that.
Note: this code relies on early binding and requires both the Microsoft XML (v6.0) and Microsoft HTML Object Library to be ticked in your references.
Sub getPrice()
Dim xhr As MSXML2.XMLHTTP60
Dim doc As MSHTML.HTMLDocument
Dim XSText As MSHTML.IHTMLElementCollection
Dim elt As MSHTML.HTMLDivElement
Dim parentElt As MSHTML.HTMLLIElement
Dim myPrice As Single
Set xhr = New MSXML2.XMLHTTP60
With xhr
.Open "GET", "https://www.avanza.se/fonder/om-fonden.html/313047/norron-active-r", False
.send
If .readyState = 4 And .Status = 200 Then
Set doc = New MSHTML.HTMLDocument
doc.body.innerHTML = .responseText
Else
MsgBox "xhr error"
Exit Sub
End If
End With
set xhr = Nothing
Set XSText = doc.getElementsByClassName("XSText")
For Each elt In XSText
If InStr(elt.innerHTML, "NAV SEK") <> 0 Then
Set parentElt = elt.parentElement
myPrice = CSng(parentElt.getElementsByClassName("SText bold")(0).innerHTML)
End If
Next
MsgBox myPrice
End Sub
Cheat - That page contains jQuery which is much nicer to use to select elements with no ID, E.g. tell it to look for a div of class XSText containing NAV SEK : div.XSText:contains('NAV SEK') and read the text of the next element:
...
Set ie_doc = ie_app.Document
''Create a new element in the document we can read from:
Dim tempInput As HTMLInputElement
Set tempInput = ie_doc.createElement("input")
tempInput.Type = "hidden"
tempInput.ID = "tempInput"
'' add it to the document
ie_doc.appendChild tempInput
'' use jQuery to lookup the value and assign it to the temp input
ie_doc.parentWindow.execScript("$('#tempInput').val($( ""div.XSText:contains('NAV SEK')"" ).next().text())")
'' read the value
msgbox tempInput.Value