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.
Related
I am trying to track packages on Pitney Bowes web site but can't seem to get the search button to not be disabled when I enter a tracking number. I have tried send Sending and Chr(13) to simulate enter key doesn't work please help I believe it is because it is a JScript page. There are a few line of code I tried which did not work they are commented out.
My code:
Set HTMLDoc = IE.document
Set HTMLInputs = HTMLDoc.getElementsByTagName("textarea")
'Set HTMLtags = HTMLDoc.getElementsById("search-box")
For Each HTMLInput In HTMLInputs
If HTMLInput.innerText = "Enter up to 50 tracking numbers (one per line, no commas)" Then
HTMLInput.Value = TNs(x, 1)
End If
'Debug.Print HTMLInput.Name, HTMLInput.tagName, HTMLInput.ID, HTMLInput.innerText
Next HTMLInput
Set HTMLButtons = HTMLDoc.getElementsByTagName("button")
If HTMLButtons(0).getAttribute("class") = "css-djgcds e1lr09737" Then
HTMLButtons(0).disabled = False
'HTMLDoc.querySelector("input[type='button']").removeAttribute ("disabled")
'iebtn = Set HTMLButtons(0).getAttribute("class") = "css-1aw3qyu e1lr09737"
End If
HTMLButtons(0).Click
Do While IE.readyState <> READYSTATE_COMPLETE
Loop
'elements of web Page:
<textarea style="height: 49px;" placeholder="Enter up to 50 tracking numbers (one per line, no _
commas)" data-test-id="search-box-input" data-gtm-id="search-box">92612927005592000013632330
</textarea>
<button class="css-djgcds e1lr09737" data-test-id="search-box-button" data-gtm-id="search-box-icon">
<i class="css-aw5xkv e1u4d0xr0"></i></button>
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
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
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
My app consists of a Masterpage with content pages. The Masterpage contains javascript functions to manipulate a treeview by dynamically selecting and expanding nodes. In one instance I am trying to call the javascript function on the Masterpage through code-behind on a content page but the javascript never gets called. I placed break points in the javascript but they never get hit.
What needs to happen is that after the projects are deleted, the content page reloads and at the same time I need the javascript function to be called.
NOTE: the javascript does work as dynamically built links throughout the system do hit the breakpoints and the function runs.
Here is the code-behind method that I am making the call to the javascript from:
Protected Overrides Sub OnDelete(ByVal SelectedItems As System.Collections.Specialized.NameValueCollection)
For i As Integer = 0 To SelectedItems.AllKeys.GetLength(0) - 1
Dim strProjectId As String = SelectedItems.AllKeys(i)
Dim objProject As New BSProject(strProjectId)
BSProject.Delete(Val(strProjectId), Page)
' log action
BSActivity.Log(Page.User.SiteUser.intID, "Project Delete", _
"Project """ & objProject.strProjectName & """ of Organization """ & _
Projects.objOrganization.strName & """ was deleted")
Next
Dim script As ClientScriptManager = Page.ClientScript
script.RegisterStartupScript(GetType(Page), "RefreshProject", "parent.refreshNodeForProjects('" & Projects.objOrganization.intID.ToString() & ":company','" & Projects.objLocation.intID.ToString() & ":location" & "');") ' "parent.refreshNodeForProjects('" & Projects.objOrganization.intID.ToString() & ":company','" & Projects.objLocation.intID.ToString() & ":location" & "');", False)
If BSConfig.GetValue("ProjectsRefresh") = "1" Then
Response.Redirect(Request.RawUrl)
End If
End Sub
Here is the javascript function on the MasterPage:
function refreshNodeForProjects(company, location) {
try {
var tree = $find("<%= radprojecttree.ClientID %>");
if (company != '') {
rootnode = tree.findNodeByValue(company);
rootnode.set_expanded(false);
rootnode.get_treeView().trackChanges();
rootnode.get_nodes().clear();
rootnode.set_expandMode(2);
rootnode.get_treeView().commitChanges();
rootnode.set_selected(true);
rootnode.set_expanded(true);
if (location != '') {
rootnode = GetNodebyValue(rootnode, location);
rootnode.set_expanded(false);
rootnode.get_treeView().trackChanges();
rootnode.get_nodes().clear();
rootnode.set_expandMode(2);
rootnode.get_treeView().commitChanges();
rootnode.set_selected(true);
rootnode.set_expanded(true);
}
scrollToNode(tree, rootnode);
}
}
catch (ex) {
throw ex;
}
}
Created dynamic registered script block to handle this issue.