Login website using VBA not taking value (Taking Keyboard Entered Value) - javascript

VBA Codes
Dim ie As Object
Dim frm As Variant
Dim element, submitInput As Variant
Dim rowCollection, htmlRow As Variant
Dim rowSubContent, rowSubData As Variant
Dim i, j, k, pauseTime As Integer
Dim anchorRange As Range, cellRng As Range
Dim start
Set ie = CreateObject("InternetExplorer.Application")
ie.navigate "URL"
While ie.readyState <> 4: DoEvents: Wend
ie.Visible = True
ie.document.getElementByID("username").Value = "ABCD"
ie.document.getElementByID("password").Value = "1234"
ie.document.getElementByID("btnLogin").Click
Application.Wait (Now + TimeValue("00:00:20"))
'++++++ Authentication ++++++++++
ie.document.querySelector("[for='What is the brand name of your first watch?'] + input").Value = "Rado"
ie.document.querySelector("[for='Which is the cinema hall closest to your residence? '] + input").Value = "Inox"
ie.document.querySelector("[value='Submit']").Click
When macro fills Authentication answer automatically and Click submit button using above vba codes,
We can see mentioned value in fields but submit button revert massage that "Fill the Fields".
When i filled same value using keyboard, its works fine, It takes only keyboard filled value
So suggest to solve Query

Related

VBA Web Automation: Trigger Return/Tab Event of Text Input [duplicate]

am trying to use automation in from Microsoft Access 2003 to control Internet Explorer 9 to complete a form using database data.
The input fires an event in the browser which validates the data and makes the save button visible. If I use sendkeys the event is triggered; however, I have found sendkeys to be very unreliable. If I change the value of the element and then use .fireevent ("onchange"), nothing happens – not even an error.
My question is, how do I fire the event. Or, how can I find out what javascript is running. Is there a debug type of addin for IE which will tell me what event is fired? If so, can I just run the script myself?
My code is below.
Set IE = CreateObject("internetexplorer.application")
IE.Visible = True
IE.Navigate "https://extranet.website.com/Planning/Edition/Periodic?language=en"
Do While IE.ReadyState <> 4 Or IE.Busy = True
DoEvents
Loop
'log in
If IE.Document.Title = "website- access" Then
IE.Document.getElementById("login_uid").Value = "username"
IE.Document.getElementById("login_pwd").Value = "password"
IE.Document.all("ButSubmit").Click
Do While IE.ReadyState <> 4 Or IE.Busy = True
DoEvents
Loop
End If
Do While Not RstAvailability.EOF
StartDate = RstAvailability!AvailDate
IE.Document.getElementById("periodStart").Value = Format(StartDate, "dd mmm yy")
IE.Document.getElementById("periodEnd").Value = Format(StartDate, "dd mmm yy")
Set LinkCollection = IE.Document.GetElementsByTagName("A")
For Each link In LinkCollection
If link.innertext = "Add" Then
link.Click
Exit For
End If
Next
Do While IE.ReadyState <> 4 Or IE.Busy = True
DoEvents
Loop
Set objRows = IE.Document.GetElementsByTagName("tr")
If RstAvailability!RoomType = "DTW" Then
n = 0
While n < objRows.Length
If Trim(objRows(n).Cells(0).innertext) = "Single Room" Then
For i = 1 To 7
'objRows(n).FireEvent ("onchange")
'objRows(n).Cells(i).GetElementsByTagName("input")(0).Focus
'SendKeys Format(RstAvailability!roomcount - RstAvailability!RoomsSold, "0") & "{TAB}"
objRows(n).Cells(i).GetElementsByTagName("input")(0).Value = Format(RstAvailability!roomcount - RstAvailability!RoomsSold, "0")
objRows(n).Cells(i).GetElementsByTagName("input")(0).fireevent ("onchange")
Do While IE.ReadyState <> 4 Or IE.Busy = True
DoEvents
Loop
Next i
End If
n = n + 1
Wend
End If
Set objButtons = IE.Document.getelementsbyname("savePlanning")
objButtons(0).Click
Do While IE.ReadyState <> 4 Or IE.Busy = True
DoEvents
Loop
newtime = Now + TimeValue("0:00:10")
Do While True
If Now > newtime Then Exit Do
Loop
RstAvailability.MoveNext
Loop
The html of the input fields are:
<tr class="first" roomId="30494" articleId="0" type="Availability" readonly="False">
<div>
<span class="roomName">
Single Room
</span>
</div>
<span class="data">
<input id="Availabilities" name="Availabilities" type="text" value="" />
</span>
<span class="data">
<input id="Availabilities" name="Availabilities" type="text" value="" />
</span>
Thanks!
After sweating over this for a few days, the answer was actually very simple but nearly impossible to find in any documentation on MSDN or anywhere else on the web.
Before you change the value of the input field, you net to set the focus on that field. After you change the value, you need to set the focus to another field. Apparently, the events fire on the loss of focus. Therefore, the code should look like this:
n = 0
While n < objRows.Length
If Trim(objRows(n).Cells(0).innertext) = "Family Room" Then
For i = 1 To 7
objRows(n).Cells(i).GetElementsByTagName("input")(0).Focus
objRows(n).Cells(i).GetElementsByTagName("input")(0).Value = Format(RstAvailability!roomcount - RstAvailability!RoomsSold, "0")
Next i
objRows(n).Cells(1).GetElementsByTagName("input")(0).Focus
End If
n = n + 1
Wend
The way I found this was by looking at some MSDN documentation about accessibility for IE9. It was advising on setting the focus for disabled users. I just thought I would give this a try and it worked. I hope this helps someone else.
Dave
If you want (in IE9) to put the following line right before line "Next i". it should also work even if you do not loose the focus?
objRows(n).Cells(i).GetElementsByTagName("input")(0).Click

Select a value from dropdown on IE page via VBA

I'm trying to select a value from a dropdown on a IE page.
I have tried a lot of methods. It doesn't do anything.
Source code of the drop down:
Codes I have tried, to select the value with "EVR" (there is only one value in the drop down):
Application.Wait Now + #12:00:06 AM#
IE.Visible = True
'IE.document.getElementById("fileOnlineReturnTaxType").Value = "EVR"
'IE.document.getElementsByName("taxType").Value = "84"
'Set oSelect = IE.document.getElementById("fileOnlineReturnTaxType")
' oSelect.Focus
' oSelect.selectedIndex = 1
' oSelect.FireEvent "onchange"
'IE.document.getElementById("fileOnlineReturnTaxType").Click
'Set Link3 = IE.document.getElementsByTagName("span")
' For Each t In Link3
' If t.innerText = "Select a tax type..." Then
' MsgBox (t.innerText)
' t.Click
' Exit For
'End If
'Next t
Try adding a change event and firing that
Option Explicit
Public Sub MakeSelection()
Dim ie As New InternetExplorer
With ie
.Visible = True
.Navigate2 "url"
While .Busy Or .readyState < 4: DoEvents: Wend
Dim event_onChange As Object
Set event_onChange = .document.createEvent("HTMLEvents")
event_onChange.initEvent "change", True, False
With .document.querySelector("#fileOnlineReturnTaxType")
.selectedIndex = 1
.FireEvent "onchange"
.dispatchEvent event_onChange
End With
Stop
.Quit
End With
End Sub

Automate webpage which use JavaScript function

I want to automate this URL. My inputs as an example:
Input boxes:
افزودن صندوق with id="symbolSearch"
افزودن شاخص with id="indexSearch"
some values for symbolSearch:
I search کیان then I click on آوای ثروت کیان-در سهام
I search خوارزمی then I click on مشترك خوارزمي-در سهام
some values for indexSearch:
I search شاخص کل then I click on شاخص کل
I search شاخص کل then I click on شاخص كل (هم وزن)
How can I automate this in VBA ?
NOTE: Each element in "symbolSearch" associate with a mutual fund which has specific RegNo. The URL search elements within this link
Sub MakeChart()
Dim appIE As Object
Set appIE = CreateObject("internetexplorer.application")
'Get the WebPage Content to HTMLFile Object
With appIE
.navigate "http://www.fipiran.ir/AnalysisTools/MFInteractiveChart"
.Visible = True
'wait until the page loads
Do While .Busy Or .readyState <> READYSTATE_COMPLETE
DoEvents
Loop
Application.Wait (Now + TimeValue("00:00:05"))
For Each cell In Range("C:C")
If Not IsNumeric(cell) Or cell.Value = "" Or cell.EntireRow.Hidden Then GoTo Next_iteration
'''
**' codes to add RegNo in range C:C to webpage **
Next_iteration:
Next
.Quit
End With
Set appIE = Nothing
End Sub
I am not sure I have understood fully. I can parse the regNos from the first link using a JSON parser and store those in an array. I can then concantenate those numbers into an XMLHTTP request URL string that returns JSON data which I store in another array which you could parse.
Option Explicit
Public Sub GetInfo()
Dim url As String, json As Object, item As Object, regNos(), responseInfo(), i As Long
url = "http://www.fipiran.ir/AnalysisTools/MFAutocomplete?term="
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url, False
.send
Set json = JsonConverter.ParseJson(.responseText)
ReDim regNos(1 To json.Count)
ReDim responseInfo(1 To json.Count)
For Each item In json
i = i + 1
regNos(i) = item("RegNo")
Next
For i = LBound(regNos) To 2 'UBound(regNos)
.Open "GET", "http://www.fipiran.ir/AnalysisTools/MFHistory?regNo=" & CStr(regNos(i)), False
.send
responseInfo(i) = .responseText
'Application.Wait Now + TimeSerial(0, 0, 1) '< == to avoid being blocked
Next
End With
End Sub
Example info in responseInfo array:
After adding the jsonconverter.bas to the project I add a reference via VBE> Tools > References to Microsoft Scripting Runtime.

onchange and onclick not work consistantly

I'm trying to scrape data from a webpage. In this process, I need to change one of
the dropdown of that web page. I was able to do that. But when I manually change the
dropdown, webpage changes it's content like images and some other text. But when I do that
using VBA it doesn't do that. I tested my code several times. So if I run the program 10
times it will change the content 1 or 2 times. So I'm confused about what happening
This is the HTML of that dropdown area.
<tbody>
<tr>
<td class="label"><label for="pa_product">Product</label></td>
<td class="value"><select id="pa_product" name="attribute_pa_product" data-attribute_name="attribute_pa_product">
<option value="">Choose an option…</option>
<option value="air-xs-2-octo-16-inch" class="attached enabled">AIR XS 2 Octo 16 Inch</option>
<option value="air-xs-2-octo-18-inch" class="attached enabled">AIR XS 2 Octo 18 Inch</option>
<option value="air-xs-2-octo-20-inch" class="attached enabled">AIR XS 2 Octo 20 Inch</option>
</select> <a class="reset_variations" href="#reset">Clear selection</a></td>
</tr>
</tbody>
And this is the code I have developed. I think onchange and onclick work rarely.
Do
DoEvents
Loop Until objIE.readystate = 4
'Body(HTML)
'MsgBox objIE.document.getElementById("tab-description").outerHTML, , "OHTML"
'MsgBox objIE.document.getElementById("tab-description").innerHTML, , "IHTML"
'MsgBox objIE.document.getElementById("tab-description").innerText, , "ITex"
WS.Range("D" & i).Value = objIE.document.getElementById("tab-description").outerHTML
'Option 1 value
'MsgBox objIE.document.getElementById("pa_product").outerHTML
'MsgBox objIE.document.getElementById("pa_product").innerHTML
'MsgBox objIE.document.getElementById("pa_product").innerText
objIE.document.getElementById("pa_product").selectedindex = 1
Application.Wait (Now + TimeValue("0:00:01"))
'modify the web page for that selected item
'For x = 1 To 5
'objIE.document.getElementById("pa_product").selectedindex = 1
Application.Wait (Now + TimeValue("0:00:03"))
objIE.document.getElementById("pa_product").FireEvent ("onchange")
objIE.document.getElementById("pa_product").FireEvent ("Onclick")
objIE.document.getElementById("pa_product").FireEvent ("onmousedown")
'Next x
Application.Wait (Now + TimeValue("0:00:03"))
WS.Range("J" & i).Value = objIE.document.getElementById("pa_product").Item(1).innerText
onchange and onclick not work consistantly
First I used one event. But no success. So I tried using all the events I found like this. FireAllEvents (objIE.document.getElementById("pa_product")) Function FireAllEvents(ByRef objHTML)
Function FireAllEvents(ByRef objHTML)
With objHTML
.FireEvent ("onblur")
.FireEvent ("onchange")
.FireEvent ("oncontextmenu")
.FireEvent ("onfocus")
.FireEvent ("oninput")
.FireEvent ("onreset")
'.FireEvent ("onsearch")
.FireEvent ("onkeydown")
.FireEvent ("onkeypress")
.FireEvent ("onkeyup")
.FireEvent ("onclick")
End With
End Function
then i called this function like this
FireAllEvents (objIE.document.getElementById("pa_product"))
Application.Wait (Now + TimeValue("0:00:03"))
WS_Oceanic.Range("J" & i).Value = objIE.document.getElementById("pa_product").Item(1).innerText
objIE.document.getElementById("pa_product").Click
But it didn't work too.
Thank you very much.
Sometimes you need to focus and unfocus an element in order for it pick up some events, or so I have found. The code below has been working reliably for me, albeit with only a few tests.
Instead of using the selected index, you can also use the value of the option to set the select value, which is what I've done below.
Public Sub SOTest()
Dim ie As Object: Set ie = CreateObject("InternetExplorer.Application")
Dim ele As Object
Const url As String = "https://oceanicaus.com.au/products/oceanic-airxs-2-octopus"
With ie
.Navigate url
.Visible = True
Do Until .readystate = 4 And Not .busy
DoEvents
Loop
Set ele = .document.getElementByID("pa_product")
With ele
.Focus
.Value = "air-xs-2-octo-16-inch"
.fireEvent ("onChange")
.document.getElementsByTagName("button")(0).Focus
End With
End With
End Sub
This is dead easy with selenium basic wrapper for VBA. After installing selenium basic you add a reference to Selenium Type Library via VBE > Tools > References
Option Explicit
Public Sub MakeSelection()
Dim d As WebDriver
Set d = New ChromeDriver
Const URL = "https://oceanicaus.com.au/products/oceanic-airxs-2-octopus/"
With d
.Start "Chrome"
.get URL
.FindElementById("pa_product").AsSelect.SelectByIndex 1 'You can also use .SelectByText
Stop
.Quit
End With
End Sub

Hit anchor tag button on loaded web page and hit Ok button with vba

I have below code which loads the web page.
I want to click on "Advanced Search" anchor tag on loaded web page and then hit OK button thereafter.
Option Explicit
Sub SaveHTml()
Dim str1, str2, str3, str4, str5, str6, str7, URL As String
Dim ie, frm As Object
Dim i As Long
Dim filename As String
Dim FF As Integer
'Dim elems As IHTMLInputTextElement
Dim wb As WebBrowser
Dim objElement As Object
Dim objCollection As Object
Dim Button As Object
'On Error Resume Next
Application.ScreenUpdating = False
str1 = Sheets("PR_data_with_search").Range("F10").Value
str2 = Sheets("PR_data_with_search").Range("I10").Value
URL = "https://webtac.industrysoftware.automation.com/webpr/webpr.php?objtype=frames" 'for TEST
filename = "C:\Users\" & Environ("UserName") & "\Desktop\Test.htm"
Set ie = CreateObject("Internetexplorer.Application")
ie.Visible = True
ie.Navigate URL
Do Until ie.ReadyState = 4
DoEvents
Loop
Set ie = Nothing
' load next web page
Dim i1 As Integer
Dim txt, p As String, link As String
txt = "Advanced Search"
Do Until link = txt
i1 = i1 + 1
p = ie.Document.Links(i1).tostring
link = Right(p, 6)
Loop
ie.Document.Links(i).Click
ie.Document.getelementsbyname("openedFrom_dateText")(0).Value = str1
ie.Document.getelementsbyname("openedTo_dateText")(0).Value = str2
'Call ie.Document.getElementsByTagName("ok").Item(1).Click
Set Button = ie.Document.getElementById("ok")
Button.Click
Do
Loop While ie.Busy
CreateObject("Scripting.FileSystemObject").CreateTextFile filename
Do Until ie.ReadyState = 4
DoEvents
Loop
FF = FreeFile
Open filename For Output As #FF
With ie.Document.body
Print #FF, .outerHTML & .innerHTML
End With
Close #FF
ie.Quit
Set ie = Nothing
Application.ScreenUpdating = True
End Sub
The html code for Advanced Search anchor tag is:
<li>Advanced Search</li>
and for Ok button on web page is:
<input type=button name="ok" id="ok" value=" OK " onClick="onSubmitFunction()">
You can introduce additional explicit waits and ensure loop until page loaded
ie.document.querySelector("a[href='javascript:parent.gotoSearch('advanced')']").Click
While IE.Busy Or IE.readyState < 4: DoEvents: Wend
Application.Wait Now + TimeSerial(0,0,2) '<== uncomment this for additional wait time. Change 2 to other # of seconds as required.
ie.document.getElementById("ok").Click
Alternatively, loop until element is set (probably should add a time-out as well):
Do
DoEvents
Dim a As Object
On Error Resume Next
Set a = IE.document.getElementById("ok")
On Error GoTo 0
Loop While a Is Nothing

Categories

Resources