I am trying to detect the number of the total pages .. so as to deal with all the pages and here's my attempt
Sub Test()
Dim bot As New WebDriver, ele As WebElement, sURL As String, x As Long
sURL = "https://mercati.ilsole24ore.com/obbligazioni/titoli-di-stato/btp/1"
bot.Start "Chrome", sURL
bot.Get sURL
'//*[#id="r_pagingArea"]/div/a[5]
Set ele = bot.FindElementByXPath("//*[#id='r_pagingArea']/div/a[5]")
For x = 1 To 10
If ele.IsDisplayed Then
Debug.Print "Page " & x
ele.Click
bot.ExecuteScript "window.focus();"
Else
Exit For
End If
Next x
MsgBox "Total of " & x & " Pages"
End Sub
After the first page it goes to the next page but got an error after that as for the ele variable
I would use a different approach and get the number of pages from
Dim numPages As Long
numPages = bot.FindElementsByCss("[href^='./']").count
Then do a loop from For i = 2 to numPages, and simply
bot.get "https://mercati.ilsole24ore.com/obbligazioni/titoli-di-stato/btp/" & i
I would avoid using your ele being set outside of loop as element may become stale after click event.
Related
I am navigating to a website using selenium VBA and I used .Get sURL
After the first iteration of rows, from which I take a number to search. I would like to delete the cookies then open new tab and do the same process but with the new tab ( and at the same time close the first window)
The problem with the website is that it shows alert when opening and that caused a problem for me. I tried to add argument and disable notifications using such a line bot.AddArgument "--disable-notifications" but this seems not to work
I have tried a lot but with no success
.Manage.DeleteAllCookies
.Wait 1000
.Manage.DeleteAllCookies
'.ExecuteScript "window.open(arguments[0])", ""
.ExecuteScript "window.open();"
.Get sURL
.SwitchToAlert.Accept
Stop
.SwitchToNextWindow
.Windows(1).Close
.Window.Activate
.SwitchToNextWindow
Simply I need to close the first window and open a new tab on which I could do the same process as for the first iteration
This is the whole code for testing
Private bot As New Selenium.ChromeDriver
Const sURL As String = "http://portal.acs.moi.gov.kw/wps/portal/!ut/p/c1/04_SB8K8xLLM9MSSzPy8xBz9CP0os3jHEEf3EENTIwMLD1dLA88Qv2AzMzM3IwMDU6B8JJK8v3-AmYGRr7G3qYmvhwEQENAdDrIPv36QvAEO4Gig7-eRn5uqH6kfZY7THncz_cic1PTE5Er9gtwIgyyTUEUANhX2ig!!/dl2/d1/L0lJSklna21DU1EhIS9JRGpBQU15QUJFUkNKRXFnL1lGTkExTkk1MC01Rjg5dyEvN19BVEFHVDE1MjA4SEU5MElUTlM2NjZGMjBHNi86bF9fXzQ1LzE5MTU4MzUzNTk!/?"
Sub Demo()
Dim eleSearch As Selenium.WebElement, m As Long, lr As Long, r As Long, cnt As Long
lr = shSheet1.Cells(Rows.Count, 1).End(xlUp).Row
m = shSheet1.Cells(Rows.Count, 2).End(xlUp).Row + 1
With bot
'.AddArgument "--headless"
.AddArgument "--disable-notifications"
.Get sURL
.SwitchToAlert.Accept
Dim f As Boolean
For r = m To lr
'If r Mod 10 = 0 Then ThisWorkbook.Save
Application.StatusBar = "Civil ID: " & shSheet1.Cells(r, 1).Value & " ------- Row " & r
If f = True Then
.Manage.DeleteAllCookies
.Wait 1000
.Manage.DeleteAllCookies
'.ExecuteScript "window.open(arguments[0])", ""
.ExecuteScript "window.open();"
.Get sURL
.SwitchToAlert.Accept
Stop
.SwitchToNextWindow
.Windows(1).Close
.Window.Activate
.SwitchToNextWindow
End If
With .FindElementByName("numberValue")
.Clear: .SendKeys shSheet1.Cells(r, 1).Value
End With
.FindElementByName("search").Click
shSheet1.Cells(r, 2).Value = Trim(.FindElementByXPath("/html/body/table/tbody/tr[2]/td/table/tbody/tr/td/table/tbody/tr/td/table/tbody/tr/td/div/table/tbody/tr/td/form/table/tbody/tr/td/table/tbody/tr[2]/td/table/tbody/tr/td/table/tbody/tr[1]/td/table/tbody/tr/td[1]/table/tbody/tr[3]/td/table/tbody/tr/td[2]").Text)
f = True
Next r
End With
Application.StatusBar = Empty
End Sub
some numbers to test on 294030604637 284083101217 290061002171
For two hours, I am trying to fix a problem of checking checkboxes on webpage that is loaded by JavaScript.
Here's the html page for the desired page
https://pastebin.com/Q1q28dR8
Here's my code till now
Private driver As New Selenium.ChromeDriver
Const sURL As String = "https://eservices.moj.gov.kw/"
Sub Test()
With driver
.Start "Chrome", sURL
.Get sURL
'#https://eservices.moj.gov.kw/#
'//*[#id="loginDiv"]/div/a[1]
.Wait 2000
''.FindElementByXPath("//*[#id='loginDiv']/div/a[1]").Click
.FindElementByClass("headerTabLeft").Click
.Wait 3000
.FindElementById("txtUserID").SendKeys "username"
.FindElementById("txtPWD").SendKeys "password"
.FindElementById("txtCaptcha").Click
.Wait 5000
.FindElementByXPath("//*[#id='frmLogin']/input[3]").Click
.Get sURL & "lawyerViews/lawOrders/"
.FindElementByLinkText("أوامر أداء جاهزة للدفع").Click
Dim dRows As Object
Set dRows = .FindElementsByCss("table.table-striped tbody tr")
'Debug.Print dRows.Count
.FindElementById("checkAll").Click
.Wait 3000
.FindElementById("checkAll").Click
.Wait 3000
Dim r As Long
For r = 1 To dRows.Count
Dim sRequestID As String
sRequestID = dRows.Item(r).FindElementsByTag("td")(2).Text
Dim x
x = Application.Match(Val(sRequestID), ActiveSheet.Columns(1), 0)
If Not IsError(x) Then
backP:
.Wait 2000
On Error Resume Next
On Error GoTo backP
.FindElementByXPath("//*[#id=""toBePaid[" & r - 1 & "]""]").Click
.Wait 2000
'.FindElementByXPath("//input[#type='checkbox'][#value='200512308']").Click
'.FindElementById("toBePaid[" & r - 1 & "]").WaitSelection True, 20000
'.Wait 2000
'.FindElementByCss("[type=checkbox][value='" & sRequestID & "']").Click
'.FindElementById("toBePaid[" & r - 1 & "]").Click
On Error GoTo 0
Debug.Print sRequestID & " Checked"
End If
Next r
Stop
End With
End Sub
The first checkbox is only selected then I got an error message saying "Element click intercepted"
I tried using id, xpath, css and no way
Any ideas?
Whilst not ideal for automation, it seems one workaround, from working through ths in chat, is to enact the click via javascript and ensure to use an attribute, rather than id, css selector
.ExecuteScript "document.querySelector(""[id='toBePaid[" & r - 1 & "]']"").click();"
I am trying the following code
Private bot As New Selenium.ChromeDriver
Sub Test()
Dim arr(), ws As Worksheet, i As Long
Const NO_JS_PROFILE As String = "C:\Users\Future\AppData\Local\Google\Chrome\User Data\Profile 1"
Const JS_PROFILE As String = "C:\Users\Future\AppData\Local\Google\Chrome\User Data\Default"
Set bot = New ChromeDriver
Set ws = ActiveSheet
arr = Application.Transpose(ws.Range("A2:A" & ws.Cells(Rows.Count, 1).End(xlUp).Row))
With bot
.SetProfile JS_PROFILE, True
.Get "https://web.whatsapp.com/send?phone=" & arr(1)
I would loop through some mobile numbers stored in the array .. and sometimes there are invalid numbers so I encountered alert message that the number is invlaid
How can I catch this alert and debug in the immediate window that the number is invalid and skip to the next number
I tried the following function
Function IsDialogPresent(driver As WebDriver) As Boolean
On Error Resume Next
Debug.Print driver.Title
IsDialogPresent = (26 = Err.Number)
End Function
and in the main code I declared a variable
Dim dlg As Alert
then I used
If IsDialogPresent(bot) Then
Set dlg = .SwitchToAlert(Raise:=False)
Stop
'Close Alert
'dlg.Dismiss
End If
but the function doesn't return True as I expected (so it seems not to be alert like I know)
I have tried so many tries and the following could solve it - but I welcome any other suggestions or ideas
Application.Wait (Now + TimeValue("00:00:05"))
If .FindElementsByXPath("//*[#id='app']/div/span[2]/div/span/div/div/div/div/div/div[1]").Count > 0 Then
Debug.Print "The Mobile " & arr(i, 1) & " Not Valid Number."
.FindElementByXPath("//*[#id='app']/div/span[2]/div/span/div/div/div/div/div/div[2]/div").Click
GoTo Skipper
End If
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
I am trying to check for some domains using selenium in VBA
Here's my try
Option Explicit
Sub Check_Domain()
Dim bot As New WebDriver
Dim sDomain As String
sDomain = "facebookopop.com"
bot.Start "chrome", "https://ae.godaddy.com/domainsearch/find?checkAvail=1&tmskey=&domainToCheck=" & sDomain
bot.Get "/"
Dim eleTaken As Object, eleAvailable As Object
bot.Wait 3000
On Error Resume Next
Set eleTaken = bot.FindElementByXPath("//text()[contains(.,'Domain Taken')]/ancestor::span[1]")
Set eleAvailable = bot.FindElementByXPath("//text()[contains(.,'Domain Available')]/ancestor::span[1]")
On Error GoTo 0
If Not eleTaken Is Nothing Then
Debug.Print "Not Avaialable"
ElseIf Not eleAvailable Is Nothing Then
Debug.Print "Avaialable"
Else
Debug.Print "Unknown"
End If
Stop
End Sub
The code runs slowly and at the same time it doesn't give me correct results all the time .. How can I check for the existence of an element in an easy way and avoid errors?
I don't know why the following code doesn't work
Sub Check_Domain_Advanced()
Dim bot As New WebDriver
Dim sDomain As String
Dim c As Range
Dim ele As Object
Dim t
Const MAX_WAIT_SEC As Long = 10
bot.Start "chrome"
For Each c In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
If Not IsEmpty(c.Value) Then
sDomain = c.Value
bot.ExecuteScript "window.open(arguments[0])", "https://ae.godaddy.com/domainsearch/find?checkAvail=1&tmskey=&domainToCheck=" & sDomain
bot.SwitchToNextWindow
t = Timer
Do
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While bot.FindElementsByCss("span[class='domain-name-text h2']").Count = 0
Set ele = bot.FindElementByCss("span[class='domain-name-text h2']")
If ele.IsPresent Then
If InStr(ele.Text, "available") Then
c.Offset(, 1).Value = "Avaialable"
ElseIf InStr(ele.Text, "taken") Then
c.Offset(, 1).Value = "Not Avaialable"
Else
c.Offset(, 1).Value = "Unknown"
End If
End If
End If
Next c
Stop
End Sub
I need to open each link in a new tab and check for the domain (available or taken) but I got errors as for the element (because of the page loads)
Any suggestions how to improve the code so as to work faster and to avoid errors?
Use the API which has a field for this. There is an exact match API as well as a cross sell.
Exact match
Option Explicit
Public Sub CheckDomainAvailability()
Dim json As Object, domains(), i As Long, url As String
domains = Array("google.com", "bszadfdws.com")
url = "https://find.godaddy.com/domainsapi/v1/search/exact?q=####&key=dpp_search&pc=&ptl=&itc=dpp_absol1"
With CreateObject("MSXML2.XMLHTTP")
For i = LBound(domains) To UBound(domains)
.Open "GET", Replace$(url, "####", domains(i)), False
.send
Debug.Print JsonConverter.ParseJson(.responseText)("ExactMatchDomain")("IsAvailable")
Next
End With
End Sub
Cross sell to look at related domains:
https://find.godaddy.com/domainsapi/v1/crosssell/all?sld=domainNameGoesHere&key=dpp_search&pc=&ptl=&itc=dpp_absol1
You would then need to look at the value for key CrossSellDomains instead of ExactMatchDomain
Requirements:
Download and add to your project jsonconverter.bas from here
VBE > Tools > References > Add reference to Microsoft Scripting Runtime
Selenium version:
Used timed loop and check contents of header for available.
Option Explicit
Public Sub CheckDomainAvailability()
Dim d As WebDriver, domains(), i As Long, t As Date, ele As Object
Const MAX_WAIT_SEC As Long = 10
domains = Array("google.com", "bszadfdws.com")
Set d = New ChromeDriver
With d
.Start "Chrome"
For i = LBound(domains) To UBound(domains)
.get "https://ae.godaddy.com/domainsearch/find?checkAvail=1&tmskey=&domainToCheck=" & domains(i)
t = Timer
Do
On Error Resume Next
Set ele = .FindElementByCss(".exact-header-tag")
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While ele Is Nothing
If Not ele Is Nothing Then
Debug.Print domains(i) & " available = " & (InStr(LCase$(ele.text), "available") > 0)
Set ele = Nothing
End If
Next
.Quit
End With
End Sub