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
Related
I am debugging some VBA code I've written in Excel 2016, and this sub is crashing Excel 2016 on windows Server with no errors.
It is crashing on the Set RegObj = GetObject...
Sub TestPrinter()
On Error GoTo e
Dim RegObj As Object
'This next line is where the crash occurs...
Set RegObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
Exit Sub
e:
MsgBox "Error number " & Err & " in TestPrinter" & vbCrLf & "Error: " & Error$(Err)
End Sub
My end goal is to enumerate the printers connected on the machine, and then set Application.ActivePrinter based on the string I pull out of the registry. This code is working fine on every other machine I've tried it on - but fails on this one server.
How can I go about debugging this? The error handler is never hit.
This does not answer your question but rather provides an alternative solution to setting the active printer.
You can use something like this to get the printer names:
Public Function GetPrinterNames() As Collection
Dim coll As New Collection
Dim i As Long
'
On Error Resume Next
With CreateObject("WScript.Network")
For i = 1 To .EnumPrinterConnections.Count Step 2
coll.Add .EnumPrinterConnections(i)
Next
End With
On Error GoTo 0
Set GetPrinterNames = coll
End Function
Note that the above does NOT give you the port number but that is not really necessary as you could use something like this to set the printer:
'*******************************************************************************
'Sets the ActivePrinter without requiring the winspool port number
'*******************************************************************************
Public Function SetPrinter(ByVal printerName As String) As Boolean
If LenB(printerName) = 0 Then Exit Function
Dim i As Long
'
On Error Resume Next
Application.ActivePrinter = printerName
If Err.Number = 0 Then
SetPrinter = True
Exit Function
End If
Err.Clear
For i = 0 To 99
Application.ActivePrinter = printerName & " on NE" & Format$(i, "00:")
If Err.Number = 0 Then
SetPrinter = True
Exit Function
End If
Err.Clear
Next i
On Error GoTo 0
End Function
I am trying to post some information into webpage and then return some other information after posting and clicking on Login button and this is my code
Sub Test()
Dim driver As New WebDriver
Dim x As Variant
Dim ele As SelectElement
Dim s As String
With driver
.Start "Chrome", "https://studea.emis.gov.eg"
.Wait (5000)
sBack:
.Get "/std_data_mail.aspx"
.FindElementById("ContentPlaceHolder1_TextBox3").SendKeys "30904201602611"
Set ele = .FindElementById("ContentPlaceHolder1_Dropyear").AsSelect
ele.SelectByValue 2009
Set ele = .FindElementById("ContentPlaceHolder1_Dropmonth").AsSelect
ele.SelectByIndex 4
Set ele = .FindElementById("ContentPlaceHolder1_DropDay").AsSelect
ele.SelectByValue 20
Set ele = .FindElementById("ContentPlaceHolder1_DropDownList5").AsSelect
ele.SelectByIndex 12
Set ele = .FindElementById("ContentPlaceHolder1_DropDownListsex").AsSelect
ele.SelectByIndex 1
.FindElementById("ContentPlaceHolder1_Button2").Click
.Wait (5000)
'.FindElementById("").SendKeys ""
On Error Resume Next
s = Empty
s = .FindElementByXPath("/html/body/span/h1").Text
On Error GoTo 0
If Left(s, 12) = "Server Error" Then
If MsgBox("Server Error. Would You Like To Try Again?", vbYesNo) = vbYes Then GoTo sBack Else Exit Sub
Else
'THIS PART DOESNOT RETURN ANYTHING
Debug.Print .FindElementById("ContentPlaceHolder1_txtsdname").Text
Debug.Print .FindElementById("ContentPlaceHolder1_txtsdid").Text
Debug.Print .FindElementById("ContentPlaceHolder1_txtsdschool").Text
End If
Stop
End With
Stop
End Sub
The code runs and when there's a server error, a message box appear to tell the user to try again. And when there is a response, I got no data although the page loaded on the driver.
I have commented the lines I got a problem at.
Can anyone figure out what I am doing wrong?
When I try to submit data to an online MS Form the submission fails upon clicking the submit button because the data in the input text box disappears.
The code I am using:
Sub Hello()
Dim objIE As Object
Dim URL As String
Dim doc As HTMLDocument
Dim oServ As Object
Dim cProc As Variant
Dim oProc As Object
URL = "https://forms.office.com/Pages/ResponsePage.aspx?id=1tUOxOPgeU2DDHmR8zp8jnPOq1Zxq2ZMgF9BFdtxEI9UNTJUSlpaNVU3S0pYRDI0MzE3UkZZQzdZNi4u"
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
objIE.navigate URL
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
Set doc = objIE.document
Set oServ = GetObject("winmgmts:")
Set cProc = oServ.ExecQuery("Select * from Win32_Process")
Dim input_text As String
input_text = "Hello!"
doc.getElementsByTagName("input")(0).Value = input_text
doc.getElementsByTagName("input")(0).setAttribute("value") = input_text
'Let us wait 5 secconds to see if the text was entered into the textbox
Application.Wait (Now() + TimeValue("00:00:05"))
doc.getElementsByTagName("button")(2).Click
'Let us wait 10 secconds to see the results before terminating IE
Application.Wait (Now() + TimeValue("00:00:10"))
Set objIE = Nothing
For Each oProc In cProc
If oProc.Name = "iexplore.exe" Then
'MsgBox "KILL" ' used to display a message for testing pur
oProc.Terminate 'kill exe
End If
Next
End Sub
I wouldn't recommend using IE for automating VBA form submission.
Here's my experience: You spend a lot of time trying to solve this kind of 'what happened the click was supposed to work' errors. Or why did the page not load all the way errors? or how do I wait for the page to load and click what it needs.
TBS: having spent too much time trying to make this sort of thing work, and oftentimes getting a good result. I'd suggest using your DevTools (f12 in IE) while on the page. First click the button normally and see what happens. Next Click the button using JavaScript run in the console section. It'll be something very similar to your click syntax. Take note of what element is actually being clicked by using the inspector in dev tools and what script is running with the event.
IE does have ways to run the exact javascript on the page, you might need to replicate the form click event and javascript using this syntax:
Call IE.document.parentWindow.execScript("document.all.myElement.focus();buttonMovimenti();", "JavaScript")
Source
I've had a lot better success using execScript to trigger OnClick(); events on the page / parentwindow. Just keep in mind iFrames can be a pain to figure out which document you're selecting so be sure to inspect the source to see if there's multiple html documents on the test page.
Alternatively you could attempt to use HTTP post / get methods to submit the form with VBA's MSXML2.XMLHTTP request object, and replicating the headers / form submission that you see in DevTools under Network tab when you click the button. This would take the timing of the page loads out of the equation, and make a more streamlined submission.
EDIT EXAMPLES:
Here's the sub I used to use for this purpose of executing scripts.
Test the script in the console of IE first. In your comment you're referencing the entire minimized JS library. What you want to do is find the function from the window that does the form submission.
Public Sub RunScriptZ(IeObjectDoc As Object, sJavaScript As String)
'run any java script on a page
Dim CurrentWindow As HTMLWindowProxy
Set CurrentWindow = IeObjectDoc.parentWindow
Call CurrentWindow.execScript(sJavaScript)
End Sub
Usually a form is submitted with a basic function like 'submitForm()'. So open DevTools with the page open, then go to Console, and type Document.submitForm(); in the console, and see what happens. Hopefully the form submits with this. Then you could something like:
Call RunScriptZ(objie.Document, "submitForm()")
If this doesn't work, sometimes a site needs you to click / hover to submit the form. You can try these variations alone or combined to see if it replicates on the web page.
Idea 1, Fire Event Method
Dim ieo As New SHDocVw.InternetExplorerMedium
Set ieoDoc = ieo.Document
ieoDoc.getElementById("buttonId").FireEvent ("Onclick")
Idea 2: Basic Exec Script
Dim ieo As New SHDocVw.InternetExplorerMedium
Set ieoDoc = ieo.Document
Dim CurrentWindow As HTMLWindowProxy
Set CurrentWindow = ieoDoc.parentWindow
Call CurrentWindow.execScript("submitForm()") ''or whatever the JS function
'name is that runs in console and triggers the event
Idea 3: test the button to see if it's clickable. sometimes web forms filled out with programming, dont register as filled in, especially if you're just assigning values. I know a lot of forms i dealt with used to require a click event on the input in order to register that a change had occurred, so check the submit button to make sure it's even clickable with this code:
Public Function TestLinkClick(linkelement As HTMLButtonElement, ForceClick
As Boolean) As Boolean
If ForceClick = True Then GoTo clickawaylabel
If IsNull(linkelement.OnClick) = False Then
clickawaylabel:
TestLinkClick = True
Debug.Print "the link is clickable"
Else 'the linkelement is not clickable
TestLinkClick = False
Debug.Print "the link is not clickable"
End If
End Function
Idea 4: Fill in a box
Public Sub FillInBox(TextValue As String, BoxName As String, IECVdoc As Object)
'fill in a box on a html page
Dim tries As Integer
tries = 0
On Error GoTo errorhandler
If tries >= 3 Then GoTo HappyEnd
startAgain:
With IECVdoc
.getElementById(BoxName).Value = TextValue
.getElementById(BoxName).FireEvent ("onchange")
End With
GoTo HappyEnd
errorhandler:
''Call a wait timer I'm using a wait sub: WaitForLoadSETx(IECVdoc, 2, 3)
tries = tries + 1
GoTo startAgain
HappyEnd:
End Sub
Idea 5: Wait for Load
Public Sub WaitForLoadSETx(ieo As Object, Maxtime As Integer, Maxtime2 As Integer)
' Wait for page to load before continuing
Dim sngTime As Single
'Const Maxtime As Integer = 5
'Const Maxtime2 As Integer = 10
sngTime = VBA.Timer ' a snapshot of the timer at the time the subroutine starts
' Wait until the webpage is doing something ... 'READYSTATE_COMPLETE <<< replaced 9/16/13 to click quicker with interactive
Do Until ieo.ReadyState <> READYSTATE_COMPLETE
DoEvents
If VBA.Timer > sngTime + Maxtime And VBA.Left(ieo.statusText, 4) = "Done" Then Exit Sub
If VBA.Timer > sngTime + Maxtime2 And ieo.ReadyState = 4 Or ieo.ReadyState = "complete" Then Exit Sub 'added this to make a real max time 1-12-15 'aded OR complete 1/14/15
' If VBA.Left(IEo.StatusText, 4) = "" Then GoTo outloop
Debug.Print "ONE LOOP Page Loading [" & VBA.Timer & "]/[" & sngTime + Maxtime & "]" & " [" & ieo.ReadyState & "]" & " [" & ieo.statusText & "]" '<<<< added 1/02/14
Loop
'outloop:
' ... and then wait for it to finish 'READYSTATE_INTERACTIVE <<< replaced 9/18/13 to click quicker with interactive
Do Until ieo.ReadyState = READYSTATE_COMPLETE
DoEvents
On Error GoTo 0
' If VBA.Timer > sngTime + Maxtime And VBA.Left(ieo.statusText, 4) = "Done" Then Exit Sub 'removed 1/14/15 because or error 438 not found on .statusText
If VBA.Timer > sngTime + Maxtime2 And ieo.ReadyState = 4 Or ieo.ReadyState = "complete" Then Exit Sub 'added this to make a real max time 1-12-15 'aded OR complete 1/14/15
Debug.Print "TWO LOOP Page Loading [" & VBA.Timer & "]/[" & sngTime + Maxtime & "]" & " [" & ieo.ReadyState & "]" '& " [" & 'ieo.statusText & "]" '<<<< added 1/02/14
Loop
0:
End Sub
Best of luck!
I tried with Sendkeys() and it solved the issue.
You need to replace these lines of code.
doc.getElementsByTagName("input")(0).Value = input_text
doc.getElementsByTagName("input")(0).setAttribute("value") = input_text
with lines of code below.
doc.getElementsByTagName("input")(0).Focus
SendKeys (input_text)
Full modified code:
Sub Hello()
Dim objIE As Object
Dim URL As String
Dim doc As HTMLDocument
Dim oServ As Object
Dim cProc As Variant
Dim oProc As Object
URL = "https://forms.office.com/Pages/ResponsePage.aspx?id=1tUOxOPgeU2DDHmR8zp8jnPOq1Zxq2ZMgF9BFdtxEI9UNTJUSlpaNVU3S0pYRDI0MzE3UkZZQzdZNi4u"
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
objIE.navigate URL
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
Set doc = objIE.document
Set oServ = GetObject("winmgmts:")
Set cProc = oServ.ExecQuery("Select * from Win32_Process")
Dim input_text As String
input_text = "Hello!"
' doc.getElementsByTagName("input")(0).Value = input_text
' doc.getElementsByTagName("input")(0).setAttribute("value") = input_text
doc.getElementsByTagName("input")(0).Focus
SendKeys (input_text)
'Let us wait 5 secconds to see if the text was entered into the textbox
Application.Wait (Now() + TimeValue("00:00:05"))
doc.getElementsByTagName("button")(2).Click
'Let us wait 10 secconds to see the results before terminating IE
Application.Wait (Now() + TimeValue("00:00:10"))
Set objIE = Nothing
For Each oProc In cProc
If oProc.Name = "iexplore.exe" Then
'MsgBox "KILL" ' used to display a message for testing pur
oProc.Terminate 'kill exe
End If
Next
End Sub
Output:
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
I am having trouble handling the error associated with a input box "Cancel" click. Or in otherwords, it returns an error within the sub if the value of the input is null. I have tried looking around and still can't seem to get it quite right. Here is my attempt:
Private Sub bttnSavingsExpected_Click()
Dim expected() As String
Dim nPeriods As Integer
Dim counter As Integer
Dim savings As Single
With ActiveSheet.Range("A13")
nPeriods = Range(.Offset(1, 0), .End(xlDown)).Rows.Count
End With
ReDim expected(1 To nPeriods)
counter = 1
For counter = 1 To nPeriods
expected(counter) = Range("A13").Offset(counter, 0).Value
Next
TryAgain:
On Error GoTo ErrH
counter = 1
For counter = 1 To nPeriods
savings = InputBox("How much savings do you expect from " & expected(counter) & "?", "Savings?", Range("A13").Offset(counter, 1).Value)
If savings = "" Then
Exit Sub
Else
Range("A13").Offset(counter, 1).Value = savings
End If
Next
Exit Sub
ErrH:
MsgBox "Please enter value. If the default value is desired then please click 'OK'.", vbOKOnly, "Do Not Click Cancel"
GoTo TryAgain
End Sub
With this attempt, the MsgBox is displayed the first click whether there is a input or not and even if I click "Ok". The second try of clicking "OK" or "Cancel" leads to being kicked back to the editor.
You've got Dim savings As Single and If savings = "" Then. Thats always going to error
Try using Dim savings As Variant
Make sure the variable for the Inbox is set at "", then test the value for False. Much easier than anything else I have seen:
Sub WolfPackURL_input()
Dim TheURL As String
Dim SaveURL As Hyperlink
Set savedURL = Sheets("Data").Range("I1")
TheURL = ""
TheURL = Application.InputBox("Input the Sign-Up URL", "Wolfpack Weekly Players URL", "http://something", 1)
If TheURL = "False" Then
Exit Sub
End If
ThisWorkbook.Worksheets("Data").Activate
Sheets("Data").Range("I1").Hyperlinks.Delete
Sheets("Data").Range("I1").ClearContents
Sheets("Data").Range("I1").Clear
ActiveSheet.Hyperlinks.Add anchor:=Sheets("Data").Range("I1"), Address:=TheURL, ScreenTip:="Open file", TextToDisplay:=TheURL
End Sub