Question

除了结尾处的.click外，我已经可以使用所有代码进行操作-相反，它禁用了单击的按钮，并且禁用了操作员按“ Enter”输入粘贴文本的功能。只有在文本框中单击并输入字符后，才能按Enter（或单击按钮）进行搜索。

Sub Part_Information()
'
' Part_Information Macro
'
' Keyboard Shortcut: Ctrl+a
'
ActiveCell.Select
Selection.Copy

Dim IE As Object
Dim MyURL As String
Dim objElement As Object
Dim objCollection As Object

Set IE = CreateObject("InternetExplorer.Application")

'''''''''''''''''''''''''''''''
'Switching to correct page
'If it can't be found, ends the sub
'If it is found, then switches to correct search bar and searches for information
'''''''''''''''''''''''''''''''

Set objShell = CreateObject("Shell.Application")
IE_count = objShell.Windows.Count
For x = 0 To (IE_count - 1)
    On Error Resume Next    ' sometimes more web pages are counted than are open
    my_url = objShell.Windows(x).document.Location
    my_title = objShell.Windows(x).document.Title

    If my_title = "Parts Intelligence" Then
        Set IE = objShell.Windows(x)
        marker = 1
        Exit For
    End If
Next
If marker = 0 Then
    MsgBox ("A matching webpage was NOT found")
Else

    Set objCollection = IE.document.getElementsByTagName("input")

    i = 0
    While i < objCollection.Length
        ''''Change name (case sensitive)
        If objCollection(i).class = "simple-search-text form-control short ng-valid ng-dirty ng-touched" Then
            ' Set text for search
            objCollection(i).Value = ActiveCell.Value
        Else
            ''''Change Type & Name (case sensitive)
            If objCollection(i).class = "btn btn-icon" Then
                objCollection(i).Click
                ' "Search" button is found
            End If
        End If
        i = i + 1
    Wend

End If
End Sub

这是从网页上获得的：

搜索按钮和搜索文本框：

Answer 1

好吧，所以首先要做的是。如果要查找已经存在的对象，请不要创建。最终，这将使您的计算机陷入困境，并在后台打开了一百个隐藏的Internet Explorer。

所以，摆脱这个

Set IE = CreateObject("InternetExplorer.Application") ''''''''''''''''''''''''''''''' 'Switching to correct page 'If it can't be found, ends the sub 'If it is found, then switches to correct search bar and searches for information ''''''''''''''''''''''''''''''' Set objShell = CreateObject("Shell.Application") IE_count = objShell.Windows.Count For x = 0 To (IE_count - 1) On Error Resume Next ' sometimes more web pages are counted than are open my_url = objShell.Windows(x).document.Location my_title = objShell.Windows(x).document.Title If my_title = "Parts Intelligence" Then Set IE = objShell.Windows(x) marker = 1 Exit For End If Next If marker = 0 Then MsgBox ("A matching webpage was NOT found") Else

而是使用类似此功能的东西-它将返回与URL和标题匹配的IE对象。

Dim IE As Object Dim MyURL As String Dim objElement As Object Dim objCollection As Object Set IE = getIE("https://myurl.com", "Parts Intelligence") If IE Is Nothing Then Rem: Add what happens if browser isn't found End If

Function GetIE(sLocation As String, sDocTitle As String) As Object Dim objShell As Object, objShellWindows As Object, o As Object Dim sURL As String, sTitle As String Dim RetVal As Object Set RetVal = Nothing Set objShell = CreateObject("shell.application") Set objShellWindows = objShell.Windows For Each o In objShellWindows sURL = "" On Error Resume Next sURL = o.document.Location sTitle = o.document.Title On Error GoTo 0 If sURL Like "*" sLocation & "*" And sTitle Like sDocTitle & "*" Then Set RetVal = o Exit For End If Next o Set GetIE = RetVal End Function

现在，关于您的问题。如果不访问相关网站，很难确切地说出导致此问题的原因。但是，我之前有过非常相似的经历，而让我克服的是通过代码激活文本框。

因此，对于您的文本框，请尝试使用：

yourTextBoxObject.setActive

然后在框中填写。这应该（希望）通过禁用按钮来解决您的问题。使用您的代码，它应该类似于：

While i < objCollection.Length ''''Change name (case sensitive) If objCollection(i).class = "simple-search-text form-control short ng-valid ng-dirty ng-touched" Then ' Set text for search objCollection(i).setActive objCollection(i).Value = ActiveCell.Value Else ''''Change Type & Name (case sensitive) If objCollection(i).class = "btn btn-icon" Then objCollection(i).Click ' "Search" button is found End If End If i = i + 1 Wend

您的完整代码：

Sub Part_Information() ' ' Part_Information Macro ' ' Keyboard Shortcut: Ctrl+a ' ActiveCell.Select Selection.Copy Dim IE As Object Dim MyURL As String Dim objElement As Object Dim objCollection As Object Dim IE As Object Dim MyURL As String Dim objElement As Object Dim objCollection As Object Set IE = getIE("https://myurl.com", "Parts Intelligence") If IE Is Nothing Then Rem: Add what happens if browser isn't found End If Set objCollection = IE.document.getElementsByTagName("input") i = 0 While i < objCollection.Length ''''Change name (case sensitive) If objCollection(i).class = "simple-search-text form-control short ng-valid ng-dirty ng-touched" Then ' Set text for search objCollection(i).Value = ActiveCell.Value Else ''''Change Type & Name (case sensitive) If objCollection(i).class = "btn btn-icon" Then objCollection(i).Click ' "Search" button is found End If End If i = i + 1 Wend End Sub

Function GetIE(sLocation As String, sDocTitle As String) As Object Dim objShell As Object, objShellWindows As Object, o As Object Dim sURL As String, sTitle As String Dim RetVal As Object Set RetVal = Nothing Set objShell = CreateObject("shell.application") Set objShellWindows = objShell.Windows For Each o In objShellWindows sURL = "" On Error Resume Next sURL = o.document.Location sTitle = o.document.Title On Error GoTo 0 If sURL Like "*" sLocation & "*" And sTitle Like sDocTitle & "*" Then Set RetVal = o Exit For End If Next o Set GetIE = RetVal End Function

无法使用点击功能

1 个答案:

您的完整代码：