Tried the below code for following URL Scripture look up. Please how to change drop down value from WEB to RV1909?
Dim Doc As HTMLDocument
Set Doc = IEApp.document
TestV2 = ""
TestV3 = ""
TestV2 = Doc.getElementsByClassName("app-list text-list")(0).innerText
Debug.Print "4b of 5: " & TestV2
IEApp.Doc.getElementsByClassName("app-list text-list").selectedIndex = 1
IEApp.Doc.getElementsByClassName("app-list text-list").FireEvent ("onchange")
TestV3 = Doc.getElementsByClassName("app-list text-list")(0).innerText
Debug.Print "4c of 5: " & TestV3
Tried many approaches from other posts, the following does not work:
IEApp.Doc.getElementsByClassName("app-list text-list")(0).innerHTML = "RV1909"
Here is the screenshot of Chrome Inspector:
In this case it's not enough just change div.app-list.text-list element innerText, as you can see that element is simple div, but not even ul. It should be changed by scripts which are called on click events. So, first of all you need to click on div to display the entire list, and then click on the RV1909 item. The below example shows how that could be done:
Sub Test()
Dim oIE As Object
Dim oDiv As Object
Set oIE = CreateObject("InternetExplorer.Application")
With oIE
.Visible = True
.Navigate "http://ebible.org/study/"
Do While .readyState <> 4 Or .Busy
DoEvents
Loop
With .Document
Do While .readyState <> "complete"
DoEvents
Loop
Set oDiv = .getElementsByClassName("app-list text-list")(0)
oDiv.Click
Do While .readyState <> "complete"
DoEvents
Loop
For Each oNode In .getElementsByClassName("text-chooser-main")(0).getElementsByClassName("text-chooser-abbr")
If oNode.innerText = "RV1909" Then
oNode.Click
Do While oDiv.innerText <> "RV1909"
DoEvents
Loop
Exit For
End If
Next
End With
End With
End Sub
Change the html div element <div class=app-list text-list>WEB</div> to <div class=app-list text-list>RV1909</div>
Related
I want to catch the anchor element in website via vba.
I tried both as an MSHTML.IHTMLAnchorElement and MSHMTL.IHTMLBUttonELement but either way gives an error on Set line. Can anyone describe what's wrong with code below?
Sub goToWhtSpp()
Dim ie As New SHDocVw.InternetExplorer
ie.Visible = True
ie.navigate "https://cooperatordirectory.com/"
Do While ie.readyState <> READYSTATE_COMPLETE Or ie.Busy
Loop
Dim doc As MSHTML.HTMLDocument
Set doc = ie.document
Application.Wait 3000
URL = "https://cooperatordirectory.com/search_results?location_value=Florida&adm_lvl_1_sn=FL&stateSearchLN=Florida&country_sn=US&location_type=administrative_area_level_1&stateSearch=FL&swlat=24.396308&nelat=31.000968&swlng=-87.634896&nelng=-79.974306&lat=27.6648274&lng=-81.5157535&faddress=Florida%2C+USA&place_id=ChIJvypWkWV2wYgR0E7HW9MTLvc"
ie.navigate URL
Dim aelement As MSHTML.IHTMLAnchorElement
Set aelement = doc.getElementsByClassName("btn btn-primary btn-block") ' err line
Dim btn As MSHTML.IHTMLButtonElement
Set btn = doc.getElementsByClassName("btn btn-primary btn-block") ' err line
Debug.Print btn.Value
End Sub
<a class="btn btn-primary btn-block" href="/pro/20220324090906/connect">Send Message</a>
You want a page load wait after each .navigate. In this case you only need the one .navigate and wait.
getElementsByClassName() returns a collection not a single node. So both your type declaration, subsequent SET attempt to this type, and later attempt to view the .value attribute will fail. .value is a property of a single node.
If you want the first "button" href then index into a correctly typed variable and call .item(0), or, more efficiently, use the querySelector() method of ie.document and pass in a single class of the multi-valued class (the one which still correctly identifies the target element).
Dim anchors As IHTMLElementCollection
Set anchors = .document.getElementsByClassName("btn-primary")
Dim anchor As IHTMLAnchorElement
Set anchor = .document.getElementsByClassName("btn-primary").Item(0)
Option Explicit
Public Sub PrintMessageUrl()
Const URL As String = "https://cooperatordirectory.com/search_results?location_value=Florida&adm_lvl_1_sn=FL&stateSearchLN=Florida&country_sn=US&location_type=administrative_area_level_1&stateSearch=FL&swlat=24.396308&nelat=31.000968&swlng=-87.634896&nelng=-79.974306&lat=27.6648274&lng=-81.5157535&faddress=Florida%2C+USA&place_id=ChIJvypWkWV2wYgR0E7HW9MTLvc"
Dim ie As SHDocVw.InternetExplorer
Set ie = New SHDocVw.InternetExplorer
With ie
.Visible = True
.navigate URL
Do While .readyState <> READYSTATE_COMPLETE Or .Busy: DoEvents: Loop
Debug.Print .document.querySelector(".btn-primary").href
.Quit
End With
End Sub
this is related to this question
scrape data from a table on a website without having to search for tags
this code worked up until a few days ago, the only change since then was changing to Windows 10 but that shouldn't affect it, should it?
also, it seems that it scrapes the first record and then gives the error. however, if i click DEBUG, then STEP OUT, it works and goes to the next record and i again have to click DEBUG, STEP OUT and so on. 81 times.
There are other functions being called from it, they just scrape more stuff and put it in a table, i don't think they're the issue, but i can add them if needed.
The line that gives the error 424 is
If .Document.getElementById("middleContent_lbType").outerHTML Like "*General Acute Care Hospital*" Then
here's the code
Public Sub VisitPages()
DoCmd.RunSQL "DELETE FROM ScrapedFacs"
AutoID = 1
Dim ie As New InternetExplorer
'Set ie = New InternetExplorerMedium
With ie
.Visible = False
.navigate "http://healthapps.state.nj.us/facilities/acSetSearch.aspx?by=county"
While .Busy Or .ReadyState < 4: DoEvents: Wend
With .Document
.querySelector("#middleContent_cbType_1").Click
.querySelector("#middleContent_cbType_4").Click
.querySelector("#middleContent_btnGetList").Click
End With
While .Busy Or .ReadyState < 4: DoEvents: Wend
Dim list As Object, i As Long
Set list = .Document.querySelectorAll("#main_table [href*=doPostBack]")
For i = 0 To list.Length - 1
list.Item(i).Click
While .Busy Or .ReadyState < 4: DoEvents: Wend
If .Document.getElementById("middleContent_lbType").outerHTML Like "*General Acute Care Hospital*" Then
FacType = "General Acute Care Hospital"
ElseIf .Document.getElementById("middleContent_lbType").outerHTML Like "*Psychiatric Hospital*" Then
FacType = "Psychiatric Hospital"
End If
Address = Replace(Replace(Replace(.Document.getElementById("middleContent_lbAddress").outerHTML, "<span id=" & Chr(34) & "middleContent_lbAddress" & Chr(34) & ">", ""), "<br>", ", "), "</span>", "")
WriteTable .Document.getElementsByTagName("table")(3), .Document.getElementById("middleContent_lbName_county").innerText
'do stuff with new page
.Navigate2 .Document.URL '<== back to homepage
While .Busy Or .ReadyState < 4: DoEvents: Wend
Set list = .Document.querySelectorAll("#main_table [href*=doPostBack]") 'reset list (often required in these scenarios)
Next
' Stop '<== Delete me later
.Quit '<== Remember to quit application
End With
End Sub
The issue is because of running code too fast
So either add a sleep before the line
Sleep 1
...Document.getElementById("middleContent_lbType")..
Or start checking if there is a return value or not
Set obj = .Document.getElementById("middleContent_lbType")
If obj is Nothing:
Sleep 1
Set obj = .Document.getElementById("middleContent_lbType")
End If
If obj.outerHTML Like "*General Acute Care Hospital*" Then
...
I've written a script in VBA using IE to reach the bottom of a web page automatically. The web page displays it's content in such a way that if I scroll downward more products become visible. I have used .scrollBy within my script to handle the lazy load.
I don't understand how to stop the scrolling when there is no more new products to load - I've used .scrollBy within a Do loop. How can I exit my loop when the scrolling is done and the browser reaches the bottom of the web page? Thanks in advance for any solution.
This is what I've tried so far:
Sub HandleLazyload()
Const URL As String = "https://www.inc.com/profile/sumup-payments-limited"
Dim IE As New InternetExplorer, HTML As HTMLDocument, post As Object
With IE
.Visible = True
.navigate URL
While .Busy = True Or .readyState < 4: DoEvents: Wend
Set HTML = .document
End With
Do
HTML.parentWindow.scrollBy 0, 99999
Application.Wait Now + TimeValue("00:00:03")
Set post = HTML.getElementsByTagName("article")
Loop ''I wish to break out of this loop when all the scrolling is done
IE.Quit
End Sub
Try the following where I used the rank to determine termination/exit of loop.
Option Explicit
Public Sub HandleLazyload()
Const URL As String = "https://www.inc.com/profile/sumup-payments-limited"
Dim IE As New InternetExplorer, HTML As HTMLDocument
With IE
.Visible = True
.navigate URL
While .Busy = True Or .readyState < 4: DoEvents: Wend
Set HTML = .document
End With
Dim rank As Long, item As Long
item = 1
Do While Err.Number = 0
HTML.parentWindow.scrollBy 0, 99999
Application.Wait Now + TimeSerial(0, 0, 1)
On Error GoTo errhand
rank = Split(HTML.querySelectorAll(".rank dt ~ dd")(item).innerText, "#")(1)
item = item + 1
Loop
errhand:
Err.Clear
Debug.Print "Stopped at rank " & rank
'Your other code
'IE.Quit
End Sub
Notes:
CSS Selector:
In case you want to know more about the CSS selector
The selector below targets all elements where class name is rank and then has sibling elements dt and dd within.
HTML.querySelectorAll(".rank dt ~ dd")(item)
Targeted HTML:
I am trying to create a code that will go to a website, put in data, submit it, and then return the answer to a cell in excel. When I step through it, it works fine, but when I just try to run it, I get run-time error 424; Object Required.
I tried looking for a good answer, but I am just not grasping on how to quite fix this. Where is my issue? How do I correct it?
Sub Distance()
Dim IE As Object
' Create InternetExplorer Object
Set IE = CreateObject("InternetExplorer.Application")
' Make visible
IE.Visible = True
' Go to site
IE.Navigate "http://www.distance-cities.com/"
' Wait while IE loading...
Do Until IE.READYSTATE = 4
DoEvents
Loop
IE.Document.getelementbyId("from").Value = "Stillwater, OK"
IE.Document.getelementbyId("to").Value = "Hollis, OK"
IE.Document.forms(0).submit
Do Until IE.READYSTATE = 4
DoEvents
Loop
'*Below is where I get my error
Sheet1.Range("E5").Value = IE.Document.getelementbyId("routemi").InnerText
IE.Quit
End Sub
I apologize if this is a bit messy.
Thanks for you help!
Something like this (untested):
Dim el as object
'...
Set el = WaitForElement(IE.Document, "routemi", 1)
If Not el is Nothing Then
Sheet1.Range("E5").Value = el.innerText
Else
Msgbox "Element 'routemi' not found!"
Exit Sub
End if
Utility function to get an element by id, waiting until it appears:
Function WaitForElement(doc As Object, id As String, maxWaitSec As Double) As Object
Dim rv As Object, t
t = Timer
Do
Set rv = doc.getElementById(id)
DoEvents
Loop While rv Is Nothing And (Timer - t) < maxWaitSec
Set WaitForElement = rv
End Function
You need to leave proper waits at each point (after .Navigate2 and .Click) to allow for page loading. I use CSS selectors to target ids as modern browsers are optimized for CSS. Also, I updated method for page navigation to .Navigate2.
Option Explicit
Public Sub Distance()
Dim ie As New InternetExplorer
With ie
.Visible = True
.Navigate2 "http://www.distance-cities.com/"
While .Busy Or .readyState < 4: DoEvents: Wend
With .document
.querySelector("#from").Value = "Stillwater, OK"
.querySelector("#to").Value = "Hollis, OK"
.querySelector("[type=submit]").Click
End With
While .Busy Or .readyState < 4: DoEvents: Wend
Debug.Print .document.querySelector("#routemi").innerText
.Quit
End With
End Sub
I am trying to automate a process where I must query a website: http://rgl.faa.gov/Regulatory_and_Guidance_Library/rgAD.nsf/MainFrame?OpenFrameset
There is a input text field <input name="query size="20"/>" that I want to populate but I am struggling to do so. Currently I am testing my code to see if I can even reference the tag.
Sub fill()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.navigate "http://rgl.faa.gov/Regulatory_and_Guidance_Library/rgAD.nsf/MainFrame?OpenFrameset"
IE.Visible = True
While IE.busy
DoEvents
Wend
For Each it In IE.Document.getElementsByTagName("input")
If it.Name = "newquery" Then
MsgBox ("yup")
End If
Next
End Sub
I think my issue is that the input field is in 2 framesets and a frame...
Any ideas if this is even possible to do?
Unless you know exactly which frame the input is in, this is a classical situation for a recursive search:
Sub fill()
Dim IE As Object, elem As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.navigate "http://rgl.faa.gov/Regulatory_and_Guidance_Library/rgAD.nsf/MainFrame?OpenFrameset"
IE.Visible = True
While IE.Busy: DoEvents: Wend
While IE.document.readyState <> "complete": DoEvents: Wend
Set elem = FindInputByName(IE.document, "newquery")
If Not elem Is Nothing Then
elem.Value = "It works!"
End If
End Sub
Function FindInputByName(document As Object, name As String) As Object
Dim i As Integer, subdocument As Object, elem As Variant
Set FindInputByName = Nothing
For i = 0 To document.frames.Length - 1
Set subdocument = document.frames.Item(i).document
Set FindInputByName = FindInputByName(subdocument, name)
If Not FindInputByName Is Nothing Then Exit Function
Next i
For Each elem In document.getElementsByTagName("INPUT")
If elem.name = name Then
Set FindInputByName = elem
Exit Function
End If
Next elem
End Function
You should try to install and use opentwebst Library : http://codecentrix.com/download.html
Don't forget to add opentwebst in project references.
It took me less time to generate the code below then writing this post :
Sub OpenTwebstMacro
Dim core As ICore
Set core = New OpenTwebstLib.core
Dim browser As IBrowser
Set browser = core.StartBrowser("http://rgl.faa.gov/Regulatory_and_Guidance_Library/rgAD.nsf/MainFrame?OpenFrameset")
Call browser.FindElement("input text", "name=newquery").InputText("YOUR QUERY")
Call browser.FindElement("input button", "uiname=Go").Click
End Sub