Question

我使用Excel VBA自动化网页。＆＃34;选择＆＃34;盒子和＆＃34;输入＆＃34;盒子是由名为＆＃34; Select2。＆＃34;

的jQuery平台创建的

当用户点击＆＃34;选择框＆＃34; （显示为输入框）会弹出一个下拉框，要求用户键入两个字符。我发现您可以通过插入选择框ID将此有效数据项添加到此框中。

myDoc.parentWindow.execScript "$('#s2id_broomCloset').val('Swiffer - Model 2010').trigger('change')"

大多数输入框与其他任何可以使用

更改的输入框一样

myDoc.GetElementByID("broomCloset").value = "Swiffer"

但是，有一个使用Select2构建的输入框，其中包含一个验证下拉列表，要求用户键入前两个字符，并列出姓氏以这两个字符开头的员工。然后，用户应该从列表中选择员工。

此输入框与＆＃34;

我能够使用

的建议

我已经尝试了我能想到的所有内容，以便在此输入框中输入有效的响应。以下是一些失败的尝试：

myDoc.GetElementByID("s2id_beanCounter").Children(0).Clicik
myDoc.parentWindow.execScript "$('#s2id_beanCounter').trigger('onclick')"

如果你能引导我回答这将是一个巨大的帮助，我怎么能在这个方框中输入一个有效的输入，或者至少如何点击该框以显示下拉列表。

编辑于06-20-2017

使用来自@dee的建议我能够将姓氏输入到可搜索的输入元素中，它会删除具有该姓氏的所有人。正如您在下面的html代码中看到的那样，下拉框中的第一个名称会突出显示。

当我将鼠标悬停在任何名称上时，鼠标下的名称将成为突出显示的名称。当然，左键单击鼠标会将该名称输入到输入框中。

如何在UL列表中自动突出显示我们需要的名称并单击它以作为有效值放入输入框？

关于此搜索的一个警告是它只搜索姓氏。

<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>

以下是我用以获取下拉框的代码，以显示我们系统中具有该姓氏的所有人的姓名。

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

Answer 1

对于select 2的版本4.0.3

解决方案1 

在select2.js中有功能：

this.$selection.on('mousedown', function (evt) {
  // Only respond to left clicks
  if (evt.which !== 1) {
    return;
  }

  self.trigger('toggle', {
    originalEvent: evt
  });
});

此函数处理mousedown的{{1}}事件，因此我首先尝试将selection发送到mousedown，以便selection打开并selection然后将文本放入搜索框。最后，有必要发送输入事件来触发搜索。

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

解决方案2

其他想法是将focus添加到selection，然后发送{ENTER}，这与用户打开selection时相同。我们需要打开selection，因为input将被添加到DOM（否则它不存在）。以下代码对我有用。

请注意SetFocusIE确保IE-Window处于活动状态，因此SendKeys将定位到正确的窗口。 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

使用的样本页

<!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>

结果im IE

编辑：对于select2的版本3.4.1

在3.4.1版中，它看起来不同。此功能可用于选择突出显示的元素：

this.dropdown.on("mouseup", resultsSelector, this.bind(function (e) {
    if ($(e.target).closest(".select2-result-selectable").length > 0) {
        this.highlightUnderEvent(e);
        this.selectHighlighted(e);
    }
}));

因此，以下代码可用于突出显示并选择其中一个已过滤的元素。 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

版本3.4.1的select2.js / css的演示页面可以从我的dropbox下载为zip文件。

Answer 2

此代码是在上述Dee的帮助下得出的，所以如果你发现它有用，请给他一个tic up。 Select2是选择框的插件助手，但在这种情况下，它使用了一个“输入”框，因此找到从下拉列表中选择的方法与选择框略有不同。您可能需要调整“儿童”元素以满足您的特定需求。在这里找到正确的元素是试错，因为它们既没有名字也没有id。

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

填写使用Select2

2 个答案: