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
Related
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 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.
I'm putting together a vocabulary list and put together a macro to pull info from vocabulary.com. The search doesn't have a button so I have to use the enter key, but Keys.Enter is not working.
The macro still works because you don't necessarily have to press the enter key for the site to show the definition page for the top most autocomplete result that pops up as you type in the search field.
The problem is that not in every case is the top most suggested result the word I am looking for. I need to get that Enter keystroke to work for this macro to be 100% useful.
Sub VocabularyWebScraper()
'Application.ScreenUpdating = False
Dim Driver As New Selenium.ChromeDriver
Dim Keys As Selenium.Keys
Dim count As Long
Sheets("Vocabulary.com Scraping").Activate
Set Driver = CreateObject("Selenium.ChromeDriver")
Set Keys = CreateObject("Selenium.Keys")
count = 1
While (Len(Range("A" & count)) > 0)
Driver.Get "https://www.vocabulary.com/dictionary/"
Driver.FindElementById("search").SendKeys Range("A" & count) + Keys.Enter
Driver.Wait 1000
On Error Resume Next
Range("B" & count) = Driver.FindElementByClass("short").Text
Range("C" & count) = Driver.FindElementByClass("long").Text
count = count + 1
Wend
Driver.Quit
'Application.ScreenUpdating = True
End Sub
I wasn't able to get the enter key to work, but just in case anyone else wants to pull definitions from Vocabularly.com here is what worked. I ended up just clicking the button of the specific word I was looking for. Worked perfectly.
Sub VocabularyWebScraper()
Application.ScreenUpdating = False
Dim Driver As New Selenium.ChromeDriver
Dim count As Long
Dim word As String
Sheets("Vocab Web Scraping").Activate
Set Driver = CreateObject("Selenium.ChromeDriver")
count = 1
While (Len(Range("A" & count)) > 0)
word = Range("A" & count)
Driver.Get "https://www.vocabulary.com/dictionary/"
Driver.FindElementById("search").SendKeys word
Driver.Wait 1000
Driver.FindElementByCss("li[word='" + word + "']").Click
Driver.Wait 2000
On Error Resume Next
Range("B" & count) = Driver.FindElementByClass("short").Text
Range("C" & count) = Driver.FindElementByClass("long").Text
count = count + 1
Wend
Driver.Quit
Application.ScreenUpdating = True
End Sub
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
All that I know now about VBA is mostly thanks to this site - you are the best <3
However, for last two days I've been looking for a solution and couldn't work it out by usual research.
Background:
I have a site with a table in it. Table represents prices for product X. There are many products, but table shows only active product. When I click on Y/Z/M, the URL stays same, only table itself updates. I need to build a database for many products, so I loop through the list by looking for elements and clicking on them and then try to fish rows/cells/etc.
Problem:
For same code, same list, same data I end up with non identical databases. Some entries are missing, some entries repeat prices of previous products etc.
Theory what's not working:
After thorough F8-testing, I think this is not working properly:
Do Until Not appIE.Busy And appIE.READYSTATE = 4
Application.Wait (Now + TimeValue("0:00:02"))
Loop
Application.Wait (Now + TimeValue("0:00:05"))
When I go through my macro by F8, all data is being fished properly. It looks like somehow the VBA doesn't wait for the html.document to fully update.
What I'de done so far:
I played around with various configurations (Do While, Do Until Not etc) of the usual loop.
I added the site to "trusted" sites in IE, as someone somewhere suggested it would help. Got scary errors afterwords and I had no idea what to do with them, so "untrusted" the site. No more error messages.
I tried to "reset" the HTML.Document.
I figured out where in the page the actual info about status bar on screen shows up and asked VBA to make sure that name changes from "Modal In" to "Modal":
Set checkA = html.getElementById("processingModal")
Dim trytry As String
Do While trytry = "modal in"
trytry = checkA.className
Application.Wait (Now + TimeValue("0:00:01"))
Loop
I still end up with messed up output.
Below, I'm adding my full code. I would also appreciate greatly any advice, as this is my first web scraping code ever and I'm self taught.
Many thanks in advance, Good People!
Sub try_this()
'trying scraping from web
Dim appIE As Object
Dim html As HTMLDocument
Dim lngRow, i, lngColumn, lngYear, a, s As Long
Dim tblSummary As IHTMLTable
Dim tblRows As IHTMLElementCollection
Dim tblRow As IHTMLElement
Dim tblCells As IHTMLElementCollection
Dim tblCell As IHTMLElement
Dim tblDataValue As String
Dim VintagesList As IHTMLElement
Dim Vintages As IHTMLElementCollection
Dim Vintage As IHTMLElement
Dim VintageYear As String
Dim BtlSizesList As IHTMLElement
Dim BtlSizes As IHTMLElementCollection
Dim BtlSize As IHTMLElement
Dim BtlSizeValue As String
Dim btlSizeID As String
Dim objA As IHTMLElement, checkA As IHTMLElement
Dim strAddress As String, strVintageY As String
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
Application.ScreenUpdating = False
'part 1: open IE browser and go to page with products
Set appIE = CreateObject("internetexplorer.application")
With appIE
.Navigate "My web Page"
.Visible = True
End With
Do While appIE.Busy 'so far works all right
DoEvents
Loop
Set html = appIE.Document
For lngYear = 2 To 16 'product category list
Application.StatusBar = "Downloading data for year " & lngYear - 1 & " of 15..."
strVintageY = Sheets("Dict").Range("A" & lngYear).Value 'first cathegory
strAddress = Sheets("Dict").Range("D2").Value & strVintageY & Sheets("Dict").Range("D4").Value & strVintageY 'changes physical address in a browser
appIE.Navigate strAddress
appIE.Visible = True
Do While appIE.Busy
Application.Wait (Now + TimeValue("0:00:02")) ' aaand wait some more, because the trick doesn't work and I'm desperate
Loop
Application.Wait (Now + TimeValue("0:00:05"))
Set html = AppIE.Document 'this is the EDIT part
'STEP 2: get available product names
Set BtlSizesList = html.getElementById("auction-size-tabs")
Set BtlSizes = BtlSizesList.Children
i = 2 'i=2, we'll start to print data into row 2
Sheets("Dict").Range("B2:B100").Clear
For Each BtlSize In BtlSizes
BtlSizeValue = BtlSize.innerText
Sheets("Dict").Cells(i, 2).Value = BtlSizeValue
i = i + 1
Next
'Step 2b: Fish Prices Data Table
lngRow = Sheets("Database").Range("D" & Rows.Count).End(xlUp).Row
s = Sheets("Dict").Range("B" & Rows.Count).End(xlUp).Row 's = last row with product's name
For a = 2 To s
btlSizeID = Sheets("Dict").Range("B" & a).Value
Set objA = html.getElementById(btlSizeID).getElementsByTagName("a")(0) 'click right product on the web page
objA.Click
'Readystate and waiting:
Do Until Not appIE.Busy And appIE.READYSTATE = 4 'wait for page to load
Application.Wait (Now + TimeValue("0:00:02"))
Loop
Application.Wait (Now + TimeValue("0:00:05"))
'this is part where I physically check if the load bar is still there:
Set checkA = html.getElementById("processingModal")
Dim trytry As String
Do While trytry = "modal in"
trytry = checkA.className
Application.Wait (Now + TimeValue("0:00:01"))
Loop
'I even tried to "reset" html.document. To be honest no idea what I'm doing here.
Set html = Nothing
Set html = appIE.Document
Set tblSummary = html.getElementById("summaryTable") 'find the table
Set tblRows = tblSummary.Rows 'get list of rows in the table
For Each tblRow In tblRows
Set tblCells = tblRow.Cells
If lngRow >= 2 Then
Sheets("Database").Range("B" & lngRow).Value = btlSizeID 'condition will be removed once I figure how to skip 1st row of table in HTML
End If
lngColumn = 3
For Each tblCell In tblCells
tblDataValue = tblCell.innerText
lngColumn = lngColumn + 1
Next
If lngRow >= 2 Then
Sheets("Database").Cells(lngRow, 1).Value = strVintageY 'paste product's category into column A
End If
lngRow = lngRow + 1 'i will be row# that will have new info pasted in it
Next
Next a
Application.ScreenUpdating = True
Next lngYear
Set html = Nothing
Set appIE = Nothing
SecondsElapsed = Round(Timer - StartTime, 2)
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
Update: As suggested, I added missing line that re-sets HTML.Documnet after .Navigate event. This didn't fix my problem though.