I am very new to VBA programming & have been trying to capture the text that gets popup on the google map when I search using GPS Coordinates (Latitude and Longitude). I have been using the website www.gps-coordinates.net.
Till now I have been able to pass the GPS Coordinates to the website input boxes and got the button clicked and the address pops'up on the google map in a box. While I am trying to get the address from the box using IE.Document.getElementById("info_window").innerText, I get an error message
Runtime Error '424' Object Required
I am not able to understand which object the code is referring to. I have search the internet for a solution but couldn't find anyone facing similar kind of problem, so couldn't find a ready solution for this. The code snippet is mentioned below:
Sub GetPlaceName()
Dim btn As Variant
Dim IE As Object, Doc As Object
Dim sDD1 As String, sDD2 As String
Dim vAdd As Variant
Dim lat As Integer, longt As Integer, latrow As Integer, longrow As Integer
latrow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row - 1
longrow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row - 1
If latrow <> longrow Then
MsgBox "The number of Latitudes & Longitudes are not equal. " & vbNewLine & " PleaseCheck...."
Else
Range("B2").Select
For i = 2 To latrow
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.navigate "http://www.gps-coordinates.net/"
Do
DoEvents
Loop Until IE.ReadyState = READYSTATE_COMPLETE
Set Doc = IE.Document
Doc.getElementById("latitude").Value = Range("B" & i).Cells.Value
Doc.getElementById("longitude").Value = Range("C" & i).Cells.Value
With Doc
Set elems = .getElementsByTagName("button")
For Each e In elems
If e.getAttribute("onclick") = "codeLatLng(1)" Then
e.Click
Exit For
End If
Next e
End With
Do
DoEvents
Loop Until IE.ReadyState = READYSTATE_COMPLETE
sDD1 = IE.Document.getElementById("info_window").innerText
vAdd = Split(sDD1, vbNewLine)
Cells(i, "E").Value = vAdd
IE.Quit
Set IE = Nothing
Set Doc = Nothing
Next i
End If
End Sub
I believe that there must be a very small error which I am not able to figure out. It must also appear to be very silly to some of you but I really need help to fix this. Hope to receive reply soon... Thanks in advance :-)
Try using
Set IE = new SHDocVw.InternetExplorer
instead of
Set IE = CreateObject("InternetExplorer.Application")
this never failed to work for me.
Related
I am trying to scrape some doctor names and addresses from the website: https://albertafindadoctor.ca/find-a-doc/directory
I am trying to solve the following issue:
Once on the doctor's toggle, I want to pull 4 pieces of data from the entire page, not just the first 25 displayed.
While the code works for the initial webpage, it only pulls the first 25 pieces of data. There are a significant number of other pages that I still need to pull (3822 different doctors).
Unfortunately, I'm at a loss on how to navigate and pull from these different pages. When I inspect elements to see how to navigate between pages a see matrix changing so I'm not sure if that has something to do with it?
Option Explicit
Sub GetAlbertaDoctors()
Dim objIE As InternetExplorer
Dim clinicEle As Object
Dim clinicName As String
Dim clinicAddress As String
Dim clinicCategory As String
Dim doctorName As String
Dim y As Integer
Set objIE = New InternetExplorer
objIE.Visible = True
objIE.Navigate "https://albertafindadoctor.ca/find-a-doc/directory"
While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Wend
Application.Wait (Now + TimeValue("0:00:5"))
objIE.Document.getElementsByClassName("physician-toggle")(0).Click
Application.Wait (Now + TimeValue("0:00:5"))
y = 2
For Each clinicEle In objIE.Document.getElementsByClassName("clinic")
clinicCategory = clinicEle.getElementsByClassName("pcn")(0).innerText
clinicName = clinicEle.getElementsByClassName("clinic-name")(0).innerText
doctorName = clinicEle.getElementsByTagName("h3")(0).innerText
clinicAddress = clinicEle.getElementsByClassName("address")(0).innerText
Sheets("Sheet2").Range("A" & y).Value = clinicCategory
Sheets("Sheet2").Range("B" & y).Value = clinicName
Sheets("Sheet2").Range("C" & y).Value = doctorName
Sheets("Sheet2").Range("D" & y).Value = clinicAddress
y = y + 1
Next
objIE.Quit
End Sub
When I run this, I get the error 91 "Object variable or With block variable not set" on the clicking line:
objIE.Document.getElementsByClassName("physician-toggle active")(0).Click
You don't need to loop all pages. You can use the browser to get to that page and click on Doctors if required. After that, grab the number of results and then mimic the xhr request the page makes for listings - which is returned as json. Alter the query string the page makes i.e. the parameter for limit to get all listings. Use a json parser (I use jsonconverter - instructions in the code for installation) to parse out your info.
There is a proper page load wait and a couple of loops to ensure elements are present. These should really be timed loops. See loop format here.
I add an additional test to ensure you do not attempt to click Doctors when it is not required to do so.
Not all listings has all info hence the On Error Resume Next paired with On Error GoTo 0. Looks like you may be able to build a dictionary to fill in some of the blank values based on existing paired values (or using ids present in json object).
I store all results in an array and write out in one go.
Option Explicit
'VBE > Tools > References:
' Microsoft Internet Controls
' Microsoft Scripting Runtime
'Download and add to standard module called jsonconverter from https://github.com/VBA-tools/VBA-JSON/blob/master/JsonConverter.bas
Public Sub GetListings()
Dim ie As InternetExplorer, s As String, json As Object, newUrl As String
Set ie = New InternetExplorer
With ie
.Visible = True
.Navigate2 "https://albertafindadoctor.ca/find-a-doc/directory"
While .Busy Or .readyState < 4: DoEvents: Wend
With .document.querySelector("[data-cp-option=physician]")
If Not .className = "physician-toggle active" Then .Click
End With
Dim resultsInfo() As String, numResults As Long, ele As Object
Do
On Error Resume Next
Set ele = .document.querySelector(".paginator")
On Error GoTo 0
Loop While ele Is Nothing
Do
Loop While .document.querySelector(".paginator").innerText = vbNullString
resultsInfo = Split(Trim$(.document.querySelector(".paginator").innerText), "of ")
.Quit
End With
numResults = resultsInfo(UBound(resultsInfo))
newUrl = "https://albertafindadoctor.ca/search/directory/physicians?page=1&limit=" & numResults & "&with[]=pcn&with[]=clinics&with[]=languages&with[]=specialties"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", newUrl, False
.send
Set json = JsonConverter.ParseJson(.responseText)("items")
End With
Dim row As Object, results(), r As Long, headers(), ws As Worksheet, key As Variant
headers = Array("clinicCategory", "clinicName", "doctorName", "clinicAddress")
Set ws = ThisWorkbook.Worksheets("Sheet1")
ReDim results(1 To json.Count, 1 To UBound(headers) + 1)
For Each row In json
r = r + 1
On Error Resume Next
For Each key In row.keys
Select Case key
Case "clinical_name"
results(r, 3) = row(key)
Case "pcn"
results(r, 1) = row(key)("name")
Case "clinics"
results(r, 2) = row(key)(1)("name")
results(r, 4) = Join$(Array(row(key)(1)("street_address"), row(key)(1)("city"), row(key)(1)("province"), row(key)(1)("postal_code")), ", ")
End Select
Next
On Error GoTo 0
Next
With ws
.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End With
End Sub
Sample output:
Reading:
querySelector
json
css selectors
arrays and arrays2
The goal is to get images from Google Images that match the part numbers in my database. My code runs, and it pulls up the correct Google pages but refuses to put the links into the spreadsheet. I have tried everything I can think of, but as of now, I keep on getting Error 1004 (Application-defined or Object-defined error).`
Sub SearchBotGoogleImgLink()
Dim objIE As Object
Set IE = CreateObject("InternetExplorer.Application")
Dim HTMLdoc As HTMLDocument
Dim imgElements As IHTMLElementCollection
Dim imgElement As HTMLImg
Dim aElement As HTMLAnchorElement
Dim n As Integer
Dim i As Integer
Dim url As String
Dim url2 As String
Dim m As Long
Dim lastRow As Long
Dim url3 As String
Dim SearchRow As Long
Dim aEle As HTMLLinkElement
Worksheets("Sheet1").Select
SearchRow = 1
Do Until IsEmpty(ActiveSheet.Cells(SearchRow, 1))
Sheets("Sheet1").Select
Application.StatusBar = SearchRow - 1 & " of " & "4368" & " Items Done"
Item = Trim(ActiveSheet.Cells(SearchRow, 1))
url = "https://www.google.com/search?hl=en&biw=1600&bih=796&tbm=isch&sa=1&ei=CTOpW_2jO6nAjwT67rqACw&q=A2N0015C3KUU&oq=" & Cells(SearchRow, 1) & "&oq=A2N0015C3KUU&gs_l=img.12...0.0..1704...0.0..0.0.0.......1......gws-wiz-img.9wB6WwQJhwA"
Set objIE = New InternetExplorer
objIE.Visible = True
objIE.navigate url
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
For Each aEle In objIE.document.getElementsByTagName("IMG")
result = aEle
Sheets("Sheet1").Range(SearchRow & "C").Value = result
Sheets("Sheet1").Range(SearchRow & "D") = aEle.innerHTML
Sheets("Sheet1").Range(SearchRow & "F").Value = aEle.innerText
Debug.Print aEle.innerText
Next
Loop
'For i = 1 To lastRow
'url = "https://www.google.com/search?hl=en&biw=1600&bih=796&tbm=isch&sa=1&ei=CTOpW_2jO6nAjwT67rqACw&q=A2N0015C3KUU&oq=" & Cells(SearchRow, 1) & "&oq=A2N0015C3KUU&gs_l=img.12...0.0..1704...0.0..0.0.0.......1......gws-wiz-img.9wB6WwQJhwA"
Set HTMLdoc = objIE.document
Set imgElements = HTMLdoc.getElementsByTagName("IMG")
n = 1
For Each imgElement In imgElements
If InStr(ingElement.src, sImageSearchString) Then
If imgElement.ParentNode.nodeName = "A" Then
Set aElement = imgElement.ParentNode
If n = 2 Then
url2 = aElement.href 'imgElement.src
url3 = imgElement.src 'aElement.href
n = n + 1
End If
End If
End If
Next
Cells(SearchRow, 5) = url2
IE.Quit
Set IE = Nothing
End Sub
Notes on your code:
You need Option Explicit at the top of your code to check on variable declarations and typos amongst other advantages. There are a number of missing declarations e.g. result, and used ones later e.g. Set IE = CreateObject("InternetExplorer.Application"). You have two different variables (one late bound and one early) both creating IE instances. You only in fact use one.
Your current error may be down to you trying to work with an object here:
result = aEle which won't work without the Set keyword to provide the required reference.
Without example URLs and expected output it is difficult to advise on the later loops in your code. You appear to have a duplicate loop over IMG elements but this time with some restrictions. It is likely these loops can be merged.
An example:
The following uses an arbitrary concatenation in to pull the img src links in from search results based on A2N0015C3KUU.
It uses a CSS selector combination of #ires img[src] to target elements with img tags and src attributes within the parent element with id ires (search results).
It is to demonstrate the principle of gathering aNodeList of matching elements and writing out to a sheet. The querySelectorAll method applied the CSS selector combination to the HTMLDocument and returns the nodeList. The nodeList is looped along its .Length, with items accessed by index starting at 0.
Option Explicit
Public Sub GetInfo()
Dim IE As New InternetExplorer
With IE
.Visible = True
.navigate "https://www.google.com/search?hl=en&biw=1600&bih=796&tbm=isch&sa=1&ei=CTOpW_2jO6nAjwT67rqACw&q=A2N0015C3KUU&oq=1&%20%22&oq=A2N0015C3KUU&gs_l=img.12...0.0..1704...0.0..0.0.0.......1......gws-wiz-img.9wB6WwQJhwA"
While .Busy Or .readyState < 4: DoEvents: Wend
Dim aNodeList As Object, i As Long
Set aNodeList = IE.document.querySelectorAll("#ires img[src]")
For i = 0 To aNodeList.Length - 1
ActiveSheet.Cells(i + 2, 4) = aNodeList.item(i).src
Next
'Quit '<== Remember to quit application
End With
End Sub
i wrote my VBA code in excel sheet as below but it is not scrape data for me and also i don't know why please any one help me. it gave me reullt as "click her to read more" onlyi want to scrape enitre data such as first name last name state zip code and so on
Sub extractTablesData()
Dim IE As Object, obj As Object
Dim myState As String
Dim r As Integer, c As Integer, t As Integer
Dim elemCollection As Object
Set IE = CreateObject("InternetExplorer.Application")
myState = InputBox("Enter the city where you wish to work")
With IE
.Visible = True
.navigate ("http://www.funeralhomes.com/go/listing/Search? name=&city=&state=&country=USA&zip=&radius=")
While IE.readyState <> 4
DoEvents
Wend
For Each obj In IE.document.all.item("state").Options
If obj.innerText = myState Then
obj.Selected = True
End If
Next obj
IE.document.getElementsByValue("Search").item.Click
Do While IE.Busy: DoEvents: Loop
ThisWorkbook.Sheets("Sheet1").Range("A1:K1500").ClearContents
Set elemCollection = IE.document.getElementsByTagName("TABLE")
For t = 0 To (elemCollection.Length - 1)
For r = 0 To (elemCollection(t).Rows.Length - 1)
For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)
ThisWorkbook.Worksheets(1).Cells(r + 1, c + 1) = elemCollection(t).Rows(r).Cells(c).innerText
Next c
Next r
Next t
End With
Set IE = Nothing
End Sub
Using the same URL as the answer already given you could alternatively select with CSS selectors to get the elements of interest, and use split to get just the names and address parts from the text. We can also do away with the browser altogether to get faster results from first results page.
Business name:
You can get the name with the following selector (using paid listing example):
div.paid-listing .listing-title
This selects (sample view)
Try
Address info:
The associated descriptive information can be retrieved with the selector:
div.paid-listing .address-summary
And then using split we can parse this into just the address information.
Code:
Option Explicit
Public Sub GetTitleAndAddress()
Dim oHtml As HTMLDocument, nodeList1 As Object, nodeList2 As Object, i As Long
Const URL As String = "http://www.funeralhomes.com/go/listing/ShowListing/USA/New%20York/New%20York"
Set oHtml = New HTMLDocument
With CreateObject("WINHTTP.WinHTTPRequest.5.1")
.Open "GET", URL, False
.send
oHtml.body.innerHTML = .responseText
End With
Set nodeList1 = oHtml.querySelectorAll("div.paid-listing .listing-title")
Set nodeList2 = oHtml.querySelectorAll("div.paid-listing .address-summary")
With Worksheets("Sheet3")
.UsedRange.ClearContents
For i = 0 To nodeList1.Length - 1
.Range("A" & i + 1) = nodeList1.Item(i).innerText
.Range("B" & i + 1) = Split(nodeList2.Item(i).innerText, Chr$(10))(0)
Next i
End With
End Sub
Example output:
Yeah, without an API, this can be very tricky at best, and very inconsistent at worst. For now, you can try the script below.
Sub DumpData()
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
URL = "http://www.funeralhomes.com/go/listing/ShowListing/USA/New%20York/New%20York"
'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
If itm.classname Like "*free-listing*" Or itm.classname Like "*paid-listing*" Then
.Range("A" & RowCount) = itm.classname
.Range("B" & RowCount) = Left(itm.innertext, 1024)
RowCount = RowCount + 1
End If
Next itm
End With
End Sub
You probably want some kind of input box to capture the city and state and radius from the user, or capture those variable in cells in your worksheet.
Notice, the '%20' is a space character.
I got this idea from a friend of mine, Joel, a long time ago. That guy is great!
I am trying to get a row of data from this table on this website: http://www.nasdaq.com/symbol/neog/financials?query=balance-sheet
Now I can manage to get the "total liabilities" row using the
doc.getelementsbyclassname("net")(3).innertext
but I cannot figure out how to get any other rows of data such as common stock.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = Range("bscode").Row And _
Target.Column = Range("bscode").Column Then
Dim IE As New InternetExplorer
IE.Visible = True
IE.navigate "http://www.nasdaq.com/symbol/" & Range("bscode").Value & "/financials?query=balance-sheet&data=quarterly"
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Dim Doc As HTMLDocument
Set Doc = IE.document
Dim sD As String
sD = Doc.getElementsByTagName("tr")(8).innerText
MsgBox sD
Dim aD As Variant
aD = Split(sD, "$")
Range("bs").Value = aD(1)
Range("ba").Value = aD(2)
Range("bb").Value = aD(3)
Range("bc").Value = aD(4)
End If
End Sub
If it helps, I have the HTML source and the tr highlighted that I want to grab.
screenshot of HTML code
The issue is the method of finding the table row data. Could someone please explain to me how to get other rows of data? It would be much appreciated !
I was able to do some trial and error and to get the correct reference this way:
Dim eTR As Object, cTR As Object, I as Integer 'I used object, because I did late binding
Set cTR = Doc.getElementsByTagName("tr")
i = 0
For Each eTR In cTR
If Left(eTR.innerText, 3) = "Com" Then
Debug.Print "(" & i; "): " & eTR.innerText
End If
i = i + 1
Next
The immediate window then displayed
(308): Common Stocks ... (a bunch of space) ...
$5,941$5,877$5,773$3,779
I then tested this statement:
sd = Doc.getElementsByTagName("tr")(308).innerText
Debug.Print sd
And got the same result.
I have this code that I have tweaked below. I use it to scrape other morningstar data, but I can't seem to make it work now for "expected return" for ETFs(Exchange Traded Funds). Everything on the code right now is set up to get the data that I need but I am having a problem getting it on the excel spreadsheet. When I do a msgBox tblTR under the code:
Set tblTR = Doc.getElementsByClassName("pr_text3")(4).innerText
I get the expected value on the message box.
However, when I take the msgbox code out, the value doesn't appear in the excel spreadsheet. I have been trying to work it out for hours now and need HELP!
Below is the entire code. under tab "Tickers2" is where I have all the tickers I would like to pull data. Examples JKE, JKF, JKD...which I have about 1000. under tab "ExpectedReturn" is where I want the data to be displayed. I think it has to do with me pulling elementsbyclassname versus when I used to pull the elementsbytagname. There wasn't in tagnames in the information i needed so I switched it to class name. Below is the entire code.
I will also mention that you have to be signed in to morningstar.com in order to get the actual data, but I am assuming that the forum can point me in the right direction without needing to be signed in.
The website is www.morningstar.com
Sub ExpectedReturn()
Dim IE As Object, Doc As Object, lastRow As Long, tblTR As Object, tblTD As Object, strCode As String
lastRow = Range("A65000").End(xlUp).Row
Set IE = CreateObject("internetexplorer.application")
IE.Visible = True
last_row = Sheets("Tickers2").Range("A1").End(xlDown).Row
ini_row_dest = 1
Sheets("ExpectedReturn").Select
Sheets("ExpectedReturn").Range("A1:H10000").ClearContents
Application.ScreenUpdating = True
For i = 1 To lastRow
Application.StatusBar = "Updating upDown" & i & "/" & last_row
row_dest = ini_row_dest + (i - 1)
strCode = "Tickers2" ' Range("A" & i).value
list_symbol = Sheets("Tickers2").Range("A" & i)
IE.navigate "http://etfs.morningstar.com/quote?t=" & list_symbol
Do While IE.readyState <> 4: DoEvents: Loop
Set Doc = CreateObject("htmlfile")
Set Doc = IE.document
tryAgain:
Set tblTR = Doc.getElementsByClassName("pr_text3")(4).innerText
MsgBox tblTR
If tblTR Is Nothing Then GoTo tryAgain
On Error Resume Next
j = 2
For Each tblTD In tblTR.getElementsByTagName("td")
tdVal = Split(tblTD.innerText, vbCrLf)
Cells(i, j) = tdVal(0)
Cells(i, j + 1) = tdVal(1)
j = j + 2
Next
Sheets("ExpectedReturn").Range("A" & row_dest).Value = list_symbol
Next i
Range("A3").Select
Application.StatusBar = False
Application.Calculation = xlAutomatic
End Sub
Thank you in advance.
-Eddie
By setting
Set tblTR = Doc.getElementsByClassName("pr_text3")(4).innerText
the variable tblTR is a string. You want a dom element, so remove the .innerText
Only then you can loop over its TD-children further down.
This was my fix
tblTR=Doc.ElementsByClassName("pr_text3)(4).innerText
Sheets("ExpectedReturn").Range("B"& row_dest).Value=tblTR