Хорошо, так обо всем по порядку. Не создавать новый объект IE, если вы пытаетесь найти объект, который уже существует.Это в конечном итоге начнет перегружать ваш компьютер с сотнями скрытых 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
и вместо этого используйте что-то вроде этой функции - которая будет возвращать объект IE, соответствующий URL-адресу и заголовку.
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