I am trying to scrape data from this website: https://portal.emsa.europa.eu/widget/web/thetis/inspections/-/publicSiteInspection_WAR_portletpublic
I need to input three values, the "Period" dates (which is ok) and select the "Flag" (in this case Portugal). This last one has proven to be a huge difficulty since typing is not an option.
Private Sub Run()
Dim objIE As Object
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
objIE.navigate ("https://portal.emsa.europa.eu/widget/web/thetis/inspections/-/publicSiteInspection_WAR_portletpublic")
Application.Wait (Now + TimeValue("0:00:13"))
objIE.document.getElementById("tdate-1028-inputEl").Value = "01/01/2019"
objIE.document.getElementById("tdate-1029-inputEl").Value = "01/09/2019"
objIE.document.getElementById("checkcombo-1014-trigger-picker").Click
If objIE.document.getElementByClass("x-boundlist-item") = """Portugal""" Then objIE.document.getElementBy("x-combo-checker").Click
End Sub
You want a timed loop waiting for presence of element to click on as well as to click parent first. Sadly, I can't see an easy way to knock out the current explicit wait time used at beginning for page load to complete
Option Explicit
Public Sub SelectFlag()
Dim ie As SHDocVw.InternetExplorer, t As Date
Const MAX_WAIT_SEC As Long = 5 '<==adjust time here
Set ie = New SHDocVw.InternetExplorer
With ie
.Visible = True
.Navigate2 "https://portal.emsa.europa.eu/widget/web/thetis/inspections/-/publicSiteInspection_WAR_portletpublic"
While .Busy Or .readyState <> 4: DoEvents: Wend
With .document
Application.Wait Now + TimeSerial(0, 0, 5)
.querySelector("#checkcombo-1014-trigger-picker").Click
Dim ele As Object
t = Timer
Do
On Error Resume Next
Set ele = .querySelector("[data-recordid='246']")
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While ele Is Nothing
If Not ele Is Nothing Then ele.Click
End With
Stop '<==Delete me later
'.quit
End With
End Sub
I have meanwhile tried another option but still without success:
Private Sub Run()
Dim objIE As Object
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
objIE.navigate ("https://portal.emsa.europa.eu/widget/web/thetis/inspections/-/publicSiteInspection_WAR_portletpublic")
Application.Wait (Now + TimeValue("0:00:13"))
Dim iL As IHTMLElement
Dim e As IHTMLElementCollection
Set e = appIE.document.getElementById("checkcombo-1014-picker").getElementsByClass("x-boundlist-item")
For Each iL In e
If iL.innerText = "Portugal" Then
iL.Click
End If
Next iL
End Sub
Related
I'm new with VBA Macro using for automate the internet explorer.
I've used it for creating bot to follow other online shopping follower (e-commerce).
Actually the code run well if I use debug 1 by 1 command, and it worked (can do the follow thing).
But if I run the whole program, the code just operate maybe several command & stopped (but it didn't error).
I used it for e-commerce (sho.ee).
The step is:
open IE for other shop's followers
grab all the link
open the new link in new IE
follow them, close the new IE
and looping.
If I run step by step it worked.
Hope you guys could help me which wrong with the code.
Here's the code => i changed the name of the shop by xxx
Sub Followers()
Dim objIE As InternetExplorer
Dim ieAnchors As Object
Dim Anchor As Object
Set objIE = New InternetExplorer
objIE.Visible = True
objIE.Navigate "https://shopee.co.id/shop/xxx/followers/"
Do While objIE.Busy = True Or objIE.ReadyState <> 4: DoEvents: Loop
Set ieAnchors = objIE.Document.getElementsByClassName("shop-href")
For Each Anchor In ieAnchors
result = Anchor
If result <> result_prev Then
Dim objIE_1 As InternetExplorer
Dim ieBtn As Object
Dim Btn As Object
Set objIE_1 = New InternetExplorer
objIE_1.Visible = True
objIE_1.Navigate Anchor
Do While objIE_1.Busy = True Or objIE_1.ReadyState <> 4: DoEvents: Loop
Set ieBtn = objIE_1.Document.getElementsByClassName("shopee-button-outline shopee-button-outline--complement shopee-button-outline--fill ")
For Each Btn In ieBtn
Btn.Click
Next Btn
objIE_1.Quit
result_prev = Anchor
End If
Next Anchor
End Sub
Sometimes pages load in parts, registering as complete before all elements have loaded. In these cases I use application.Wait to force the program to wait a set amount of time for page loads:
'wait five seconds
Application.Wait (Now + TimeValue("0:00:05"))
If it is a simple page, I will have a Do loop a check for ReadyState to avoid slowing the program down unnecessarily:
'wait for page to load
Do Until ie.ReadyState = READYSTATE_COMPLETE or ie.ReadyState = 4
DoEvents
Loop
yes it worked. by adding Application.Wait (Now + TimeValue("0:00:05"))
Sub Followers()
Dim objIE As InternetExplorer
Dim ieAnchors As Object
Dim Anchor As Object
Set objIE = New InternetExplorer
objIE.Visible = True
objIE.Navigate "https://shopee.co.id/shop/xxx/followers/"
Do While objIE.Busy = True Or objIE.ReadyState <> 4: DoEvents: Loop
Application.Wait (Now + TimeValue("0:00:02"))
Set ieAnchors = objIE.Document.getElementsByClassName("shop-href")
For Each Anchor In ieAnchors
result = Anchor
If result <> result_prev Then
Dim objIE_1 As InternetExplorer
Dim ieBtn As Object
Dim Btn As Object
Application.Wait (Now + TimeValue("0:00:02"))
Set objIE_1 = New InternetExplorer
objIE_1.Visible = True
objIE_1.Navigate Anchor
Do While objIE_1.Busy = True Or objIE_1.ReadyState <> 4: DoEvents: Loop
Set ieBtn = objIE_1.Document.getElementsByClassName("shopee-button-outline shopee-button-outline--complement shopee-button-outline--fill ")
For Each Btn In ieBtn
Btn.Click
Next Btn
objIE_1.Quit
result_prev = Anchor
End If
Next Anchor
End Sub
I'm trying to create a script in vba to select dates according to my preferable input date, as in 03/11/2019 and output date, as in 05/11/2019 for the two fields check-in and chek-out. the macro that I've written so far can click on those fields but can't fill in the inputs with the aforesaid dates.
Website address
I've tried:
Sub FillInTheForm()
Dim IE As New InternetExplorer, HTML As HTMLDocument
Dim post As Object, elem As Object, guest As Object
Dim findbtn As Object, URL$
URL = "https://www.discoverqatar.qa/"
With IE
.Visible = True
.navigate URL
While .Busy = True Or .readyState < 4: DoEvents: Wend
Application.Wait Now + TimeValue("00:00:05")
Set post = .document.querySelector("[class='rsp_s_checkindate_input'] > #lpPannel_txtFromDate")
post.Focus
post.Click
Application.Wait Now + TimeValue("00:00:05")
Set elem = .document.querySelector("[class='rsp_s_checkoutdate_input'] > #lpPannel_txtToDate")
elem.Focus
elem.Click
Application.Wait Now + TimeValue("00:00:05")
Set guest = .document.querySelector("#lblPaxInfo")
guest.Focus
guest.Click
Application.Wait Now + TimeValue("00:00:05")
Set findbtn = .document.querySelector("input#btnSearch")
findbtn.Focus
findbtn.Click
End With
' IE.Quit
End Sub
Some intentional delays are there within the script which I can kick out later defining any timed loop.
How can I fill in the dates in those boxes to perform a customized search?
Just set the value attributes
Option Explicit
Public Sub SetDates()
Dim ie As InternetExplorer
Set ie = New InternetExplorer
With ie
.Visible = True
.Navigate2 "https://www.discoverqatar.qa/"
While .Busy Or .readyState <> 4: DoEvents: Wend
With .document
.querySelector("#lpPannel_txtFromDate").Value = "03/11/2019"
.querySelector("#lpPannel_txtToDate").Value = "05/11/2019"
.querySelector("#btnSearch").Click
Stop
End With
End With
End Sub
I need to capture the windows and need to navigate further, I am able to capture using the below code,
With objIE
Application.Wait (Now + TimeValue("00:00:05"))
Set TBL = .document.getElementById("payersitecredential-table")
Set PRV = TBL.getElementsByTagName("A"): PRV.Item(1).Click
'once the above code runs, it opens up an another window and i need to set that window as object.
Application.Wait (Now + TimeValue("00:00:20"))
End With
For Each WINDW In CreateObject("Shell.Application").Windows
If WINDW.Name = "Internet Explorer" Then
If InStr(WINDW.LocationURL, "newmmis") <> 0 Then
Set objIE1 = WINDW
Exit For
ElseIf InStr(WINDW.LocationURL, "https://www.example.com") <> 0 Then
Set ClsWindw = WINDW
ClsWindw.Quit
GoTo ThEnD
End If
End If
Next
With objIE1
Do While .Busy Or .readyState <> 4 'this is the place i get error as object required
DoEvents
Loop
Application.Wait (Now + TimeValue("00:00:05"))
.document.getElementById("InquireStatus").Click
End With
i have kept a wait time of 60 seconds for the URL to load, but sometimes the URL takes much time to load, at that time it is unable to set the object, could you guys let me figure out this and give me a solution.
Please see this in support of my comment
Sub ex()
Dim ie As SHDocVw.InternetExplorer
Dim wins As New SHDocVw.ShellWindows
For Each ie In wins
Debug.Print ie.Document.URL, ie.ReadyState, ie.Busy
Next ie
End Sub
EDIT
I would utilise the above, like so, this will find the IE based on URL and wait until it's ready and return, so use set IE=GetMeReadyIE("http://stackoverflow.com/questions/tagged/vba") for example.
Function GetMeReadyIE(strURL As String) As SHDocVw.InternetExplorer
Dim ie As SHDocVw.InternetExplorer
Dim wins As New SHDocVw.ShellWindows
For Each ie In wins
If ie.Document.URL = strURL Then
While ie.ReadyState <> READYSTATE_COMPLETE Or ie.Busy
DoEvents
Wend
Set GetMeReadyIE = ie
Exit For
End If
Next ie
End Function
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