问题
I'm using Excel VBA to automate a web page. The "Select" boxes and "Input" boxes were created by a jQuery platform called "Select2."
When the user clicks on a "Select box" (which appears as an input box) a dropdown box pops up asking the user to type in two characters. I've discovered that you can add a valid data item into this box with this command by inserting the select box ID.
myDoc.parentWindow.execScript "$('#s2id_broomCloset').val('Swiffer - Model 2010').trigger('change')"
Most of the input boxes are like any other where you can change them with
myDoc.GetElementByID("broomCloset").value = "Swiffer"
However, there is one input box built with Select2 which involves a validation drop down list asking the user to type the first two characters and it lists employees whose last names start with those two characters. Then the user is supposed to select the employee from the list.
This input box is tied to an "
I was able to use the advice of
I have tried everything I can think of to enter a valid response into this input box. Here are a couple of failed attempts:
myDoc.GetElementByID("s2id_beanCounter").Children(0).Clicik
myDoc.parentWindow.execScript "$('#s2id_beanCounter').trigger('onclick')"
It would be a tremendous help if you could lead me to an answer as how can I put a valid input into this box or at least how to click the box to make the drop down list appear.
Edited 06-20-2017
Using advice from @dee I was able to get the last name into the searchable input elelment and it drops down all of the people with that last name. As you can see from the html code below the first name in the drop down box is highlighted.
When I hover the mouse over any of the names, the name under the mouse becomes the highlighted name. And of course a left click of the mouse enters that name into the input box.
How can I automate the process of highlighting the name we need form the UL list and click it to put into the input box as a valid value?
The one caveat about this search is that it only searches the last name.
<div class="select2-drop select2-display-none bigdrop select2-with-searchbox select2-drop-active" id="select2-drop" style="left: 1049.13px; top: 227.83px; width: 238px; display: block;">
<div class="select2-search">
<input class="select2-input" spellcheck="false" type="text" autocomplete="off" autocapitalize="off" autocorrect="off">
</div>
<ul class="select2-results">
<li class="select2-results-dept-0 select2-result select2-result-selectable select2-highlighted">
<div class="select2-result-label">
<div>JOSEPH MENGELA (ARGENTINA)</div></div>
</li>
<li class="select2-results-dept-0 select2-result select2-result-selectable">
<div class="select2-result-label">
<div>TOMMY MENGELA (ITALY)</div>
</div>
</li>
<li class="select2-results-dept-0 select2-result select2-result-selectable">
<div class="select2-result-label">
<div>SUSAN H MENGELA (POLAND)</div>
</div>
</li>
</ul>
</div>
Here is the code I used to get the dropdown box to show all the names of people in our system with that last name.
Set myElement = myDoc.getElementById("s2id_IDofInputBoxHere").Children(0)
SendMouseDownEvent myDoc, myElement
Set myElement = myDoc.getElementById("select2-drop").Children(0).Children(0)
myDoc.getElementById("select2-drop").Children(0).Children(0).Value = "mengela"
' Send input event to trigger searching of text 'BR"
Dim kev
Set kev = myDoc.createEvent("KeyboardEvent")
kev.initEvent "input", True, False
myElement.dispatchEvent kev
回答1:
For Version 4.0.3 of select 2
Solution 1
In select2.js there is function:
this.$selection.on('mousedown', function (evt) {
// Only respond to left clicks
if (evt.which !== 1) {
return;
}
self.trigger('toggle', {
originalEvent: evt
});
});
This function handles the mousedown event of the selection so first I have tried to send mousedown to the selection so we get the selection open and then to put the text into search box. Finally it is necessary to send input event to trigger searching.
Sub Select2Demo()
Dim ie As SHDocVw.InternetExplorer
Dim doc As MSHTML.HTMLDocument
Dim url As String
url = "file:///C:/Temp/StackOverflow/html/Select2VbaDemo.html"
Set ie = New SHDocVw.InternetExplorer
ie.Visible = True
ie.navigate url
While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
DoEvents
Wend
Set doc = ie.document
' Open drop down
Dim sp As HTMLSpanElement
Set sp = doc.querySelector("span[class^=select2-selection]")
SendMouseDownEvent doc, sp
' Put value into search box
Dim inp
Set inp = doc.querySelector("input[class=select2-search__field]")
inp.Value = "BR"
' Send input event to trigger searching of text 'BR"
Dim kev
Set kev = doc.createEvent("KeyboardEvent")
kev.initEvent "input", True, False
inp.dispatchEvent kev
'ie.Quit
End Sub
Private Sub SendMouseDownEvent(doc As MSHTML.HTMLDocument, target As IEventTarget)
Dim mev As Object
Dim eventType As String
Dim canBubble As Boolean
Dim cancelable As Boolean
Dim viewArg As IHTMLWindow2
Dim detailArg As Long
Dim screenXArg As Long
Dim screenYArg As Long
Dim clientXArg As Long
Dim clientYArg As Long
Dim ctrlKeyArg As Boolean
Dim altKeyArg As Boolean
Dim shiftKeyArg As Boolean
Dim metaKeyArg As Boolean
Dim buttonArg As Object ' Unsupported Variant-Type
Dim relatedTargetArg As IEventTarget
Set mev = doc.createEvent("MouseEvent")
eventType = "mousedown"
canBubble = True
cancelable = False
Set viewArg = doc.parentWindow
Set relatedTargetArg = target
mev.initMouseEvent eventType, canBubble, cancelable, viewArg, _
detailArg, screenXArg, screenYArg, clientXArg, clientYArg, _
ctrlKeyArg, altKeyArg, shiftKeyArg, metaKeyArg, buttonArg, _
relatedTargetArg
target.dispatchEvent mev
End Sub
Solution 2
Other idea would be to put focus to the selection and simply send {ENTER} which is the same as when the user opens the selection.
We need the selection to be opened because then the input will be added to the DOM (otherwise it is not there). The following code worked for me.
Notice the SetFocusIE which ensures that the IE-Window is active one and so the SendKeys will target the right window. HTH.
Option Explicit
' Add reference to Microsoft Internet Controls (SHDocVw)
' Add reference to Microsoft HTML Object Library
Private Declare Function SetFocusIE Lib "user32" Alias "SetFocus" _
(ByVal hwnd As Long) As Long
Sub Select2Demo2()
Dim ie As SHDocVw.InternetExplorer
Dim doc As MSHTML.HTMLDocument
Dim url As String
url = "file:///C:/Temp/StackOverflow/html/Select2VbaDemo.html"
Set ie = New SHDocVw.InternetExplorer
ie.Visible = True
ie.navigate url
While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
DoEvents
Wend
Set doc = ie.document
Dim sp As HTMLSpanElement
Set sp = doc.querySelector("span[class^=select2-selection]")
sp.Click ' Selection gets focus
SetFocusIE ie.hwnd ' IE gets active window
SendKeys "~", True ' Sends ENTER: Selection opens
' put value to search box then
Dim inp
Set inp = doc.querySelector("input[class=select2-search__field]")
inp.Value = "BR"
ie.Quit
End Sub
Sample page used
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<!-- saved from url=(0016)http://localhost -->
<meta content="text/html; charset=utf-8" http-equiv="Content-Type" />
<script type="text/javascript" src="https://code.jquery.com/jquery-2.2.4.min.js"></script>
<link href="https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.3/css/select2.min.css" rel="stylesheet" />
<script type="text/javascript" src="https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.3/js/select2.js"></script>
<title>Untitled 1</title>
</head>
<body>
<script type="text/javascript">
$(document).ready(function() {
$("#s2id_beanCounter").select2();
});
</script>
<div class="s2-example" >
<label class="control-label" for="s2id_beanCounter">
Enter Employee Name
<select class="js-example-basic-single js-states form-control" id="s2id_beanCounter" style="width:100%">
<option value="JD">John Doe</option>
<option value="BL">Bruce Lee</option>
</select>
</label>
</div>
</body>
</html>
Result im IE
EDIT: For Version 3.4.1 of select2
In version 3.4.1 it looks different. There is this function resposible for selecting the highlighted element:
this.dropdown.on("mouseup", resultsSelector, this.bind(function (e) {
if ($(e.target).closest(".select2-result-selectable").length > 0) {
this.highlightUnderEvent(e);
this.selectHighlighted(e);
}
}));
So the following code can be used to highlight and select one of the filtered elements. HTH
Option Explicit
' Add reference to Microsoft Internet Controls (SHDocVw)
' Add reference to Microsoft HTML Object Library
Sub Select2DemoVersion341()
Dim ie As SHDocVw.InternetExplorer
Dim doc As MSHTML.HTMLDocument
Dim url As String
url = "file:///C:/Temp/StackOverflow/html/select2demo/Select2VbaDemo.html"
Set ie = New SHDocVw.InternetExplorer
ie.Visible = True
ie.navigate url
While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
DoEvents
Wend
Set doc = ie.document
' Get reference to target serach input box before select2 starts to mess up with the DOM when the select opens
Dim inp As HTMLInputElement
Set inp = doc.querySelector("div[class^=select2-container] input[class=select2-input]")
' Open drop down
Dim select2Choice As HTMLAnchorElement
Set select2Choice = doc.querySelector("a[class^=select2-choice]")
SendMouseEvent doc, select2Choice, "mousedown"
' Put value into search box
inp.Value = "mengela"
' Send input event to trigger searching of text 'mengela"
Dim kev
Set kev = doc.createEvent("KeyboardEvent")
kev.initEvent "input", True, False
inp.dispatchEvent kev
' Get the search results
Dim selectResultUl As HTMLUListElement
Set selectResultUl = doc.querySelector("ul[class=select2-results]")
If selectResultUl.Children.Length = 1 Then
' Verify 'No results found' posibility
If selectResultUl.Children(0).className = "select2-no-results" Then
MsgBox "No results"
ie.Quit
Exit Sub
End If
End If
' Deselect currently selected item by removing select2-highlighted class
Dim selectedResultsLis As IHTMLElementCollection
Dim selectResultsLi As HTMLLIElement
Set selectedResultsLis = selectResultUl.getElementsByTagName("li")
For Each selectResultsLi In selectedResultsLis
If selectResultsLi.className Like "*select2-highlighted*" Then
selectResultsLi.className = VBA.Strings.Replace(selectResultsLi.className, "select2-highlighted", "")
Exit For
End If
Next selectResultsLi
' Select another li-element, e.g. last one by adding select2-highlighted class
Dim newSelectionLi As HTMLLIElement
Set newSelectionLi = selectedResultsLis(selectedResultsLis.Length - 1)
newSelectionLi.className = newSelectionLi.className & " select2-highlighted"
' Send mouseup to result label to select the highligted element
Dim resultLabel As HTMLDivElement
Set resultLabel = newSelectionLi.getElementsByClassName("select2-result-label")(0)
SendMouseEvent doc, resultLabel, "mouseup"
'ie.Quit
End Sub
Private Sub SendMouseEvent(doc As MSHTML.HTMLDocument, target As IEventTarget, eventTypeVal)
Dim mev As Object
Dim eventType As String
Dim canBubble As Boolean
Dim cancelable As Boolean
Dim viewArg As IHTMLWindow2
Dim detailArg As Long
Dim screenXArg As Long
Dim screenYArg As Long
Dim clientXArg As Long
Dim clientYArg As Long
Dim ctrlKeyArg As Boolean
Dim altKeyArg As Boolean
Dim shiftKeyArg As Boolean
Dim metaKeyArg As Boolean
Dim buttonArg As Object ' Unsupported Variant-Type
Dim relatedTargetArg As IEventTarget
Set mev = doc.createEvent("MouseEvent")
eventType = eventTypeVal
canBubble = True
cancelable = False
Set viewArg = doc.parentWindow
Set relatedTargetArg = target
mev.initMouseEvent eventType, canBubble, cancelable, viewArg, _
detailArg, screenXArg, screenYArg, clientXArg, clientYArg, _
ctrlKeyArg, altKeyArg, shiftKeyArg, metaKeyArg, buttonArg, _
relatedTargetArg
target.dispatchEvent mev
End Sub
Demo page with select2.js/css of version 3.4.1 can be downloaded from my dropbox as zip file.
回答2:
This code was derived with the help of Dee above, so if you find it useful please give him a tic up. Select2 is an addon helper for select boxes, but in this case it used an "input" box so finding a way to select from a dropdown list is a bit different than for the selectboxes. You might need to adjust the 'children' elements to suit you specific needs. Here it was trial and error to find the correct elements because they had neither names or id's.
Sub open_EMPLOYEE_name_box_1()
Dim ie As SHDocVw.InternetExplorer, _
i As Long, objShell, objAllWindows, ow, myElement As IEventTarget, _
myArray1() As String, tempNumb As Integer, myDoc As HTMLDocument, kev
i = 2: tempNumb = 1: ReDim myArray1(1 To 1):
ReDim myArray1(1 To 1): Set objShell = CreateObject("Shell.Application")
Set objAllWindows = objShell.Windows
For Each ow In objAllWindows
If (InStr(1, ow, "Internet Explorer", vbTextCompare)) Then
If ow.document.Title = "Company Name : Company Page" Then
Set ie = ow
Set myDoc = ie.document
GoTo mainProg
End If
tempNumb = tempNumb + 1
If Not ow.document.Title = "" Then
ReDim Preserve myArray1(1 To tempNumb)
Else
Exit For
End If
i = i + 1
End If
Next
mainProg:
'///////////////////// THIS BRINGS UP THE SMITH LIST
Set myElement = myDoc.getElementById("s2id_employeeName").Children(0)
SendMouseDownEvent myDoc, myElement
Set myElement = myDoc.getElementById("s2id_employeeName").Children(0)
Set myElement = myDoc.getElementById("select2-drop").Children(0).Children(0)
myElement.Value = "Smith"
Set kev = myDoc.createEvent("KeyboardEvent")
kev.initEvent "input", True, False
myElement.dispatchEvent kev
'/////////////////////////// THIS SELECTS "STEVEN R BISHOP (HEBRON)"
Application.Wait Now + #12:00:03 AM# ' 3 second wait for dropdown box to finish
Set myClassResults = myDoc.getElementsByClassName("select2-result-label")
For Each cl In myClassResults
If cl.innerText = "STEVEN R SMITH (CARMEL)" Then
Set myElement = cl
SendMouseUpEvent myDoc, myElement
End If
Next
endItAll:
Set myClassResults = Nothing
Set myElement = Nothing
Set objAllWindows = Nothing
Set myDoc = Nothing
Set ie = Nothing
End Sub
Private Sub SendMouseDownEvent(doc As MSHTML.HTMLDocument, target As IEventTarget)
Dim mev As Object
Dim eventType As String
Dim canBubble As Boolean
Dim cancelable As Boolean
Dim viewArg As IHTMLWindow2
Dim detailArg As Long
Dim screenXArg As Long
Dim screenYArg As Long
Dim clientXArg As Long
Dim clientYArg As Long
Dim ctrlKeyArg As Boolean
Dim altKeyArg As Boolean
Dim shiftKeyArg As Boolean
Dim metaKeyArg As Boolean
Dim buttonArg As Object ' Unsupported Variant-Type
Dim relatedTargetArg As IEventTarget
Dim kev
Set mev = doc.createEvent("MouseEvent")
eventType = "mousedown"
canBubble = True
cancelable = False
Set viewArg = doc.parentWindow
Set relatedTargetArg = target
mev.initMouseEvent eventType, canBubble, cancelable, viewArg, _
detailArg, screenXArg, screenYArg, clientXArg, clientYArg, _
ctrlKeyArg, altKeyArg, shiftKeyArg, metaKeyArg, buttonArg, _
relatedTargetArg
target.dispatchEvent mev
End Sub
Private Sub SendMouseUpEvent(doc As MSHTML.HTMLDocument, target As IEventTarget)
Dim mev As Object
Dim eventType As String
Dim canBubble As Boolean
Dim cancelable As Boolean
Dim viewArg As IHTMLWindow2
Dim detailArg As Long
Dim screenXArg As Long
Dim screenYArg As Long
Dim clientXArg As Long
Dim clientYArg As Long
Dim ctrlKeyArg As Boolean
Dim altKeyArg As Boolean
Dim shiftKeyArg As Boolean
Dim metaKeyArg As Boolean
Dim buttonArg As Object ' Unsupported Variant-Type
Dim relatedTargetArg As IEventTarget
Dim kev
Set mev = doc.createEvent("MouseEvent")
eventType = "mouseup"
canBubble = True
cancelable = False
Set viewArg = doc.parentWindow
Set relatedTargetArg = target
mev.initMouseEvent eventType, canBubble, cancelable, viewArg, _
detailArg, screenXArg, screenYArg, clientXArg, clientYArg, _
ctrlKeyArg, altKeyArg, shiftKeyArg, metaKeyArg, buttonArg, _
relatedTargetArg
target.dispatchEvent mev
End Sub
来源：https://stackoverflow.com/questions/44545772/filling-html-input-boxes-that-were-created-with-select2