填写网页文本框的 Excel VBA 问题

Question

我正在尝试在网页上的文本框中输入文本。

<div lightning-input_input="" class="slds-form-element__control slds-grow">
<input lightning-input_input="" type="text" id="input-32" placeholder="Enter an address, city, zip, or place" class="slds-input">
</div>

我在我的 excel 宏中使用这一行来尝试在该框中输入“test”：

Application.Wait DateAdd("s", 5, Now)
objIE.document.all.item("input-32")(0).Value="test"

此代码适用于其他站点，但我无法弄清楚为什么它不适用于上面的对象。

完整代码：

sub searchbot()
 Dim objIE as InternetExplorer
 Dim aEle as IHTMLElement
 
 Set objIE = New InternetExplorer
 objIE.visible = True
 objIE.navigate "https://myturnvolunteer.ca.gov/s/#search"

 Do While objIE.Busy = True or objIE.readyState <>4: DoEvents:  Loop
 'That doesnt seem to wait long enough so
 Application.Wait DateAdd("s", 5, Now)

 objIE.document.all.Item("radioButtonGroup")(1).Click  'this works!
 Set device = objIE.document.getElementsByClassName("input-slds") 'Error!
 device(0).Value = "test"

End Sub

Answer 1

在导航到您的网页并等待它加载后，如果您运行以下代码行：

Debug.Print TypeName(IE.Document.getElementsByClassName("slds-form"))

你会看到在Immediate Window你得到的东西JScriptTypeInfo实际上你期待一个DispHTMLElementCollection.

要解决此问题，您需要添加对Microsoft HTML Object Library的引用。如果列表中没有它，那么只需浏览mshtml.tlb类型库：

现在上面的代码行可以变成：

Dim doc As HTMLDocument
Set doc = IE.Document
    
Debug.Print TypeName(doc.getElementsByClassName("slds-form"))

现在可以DispHTMLElementCollection正确打印到直接窗口。

如果您使用该doc变量，则所有类似doc.getElementsByClassName或的功能doc.getElementById都将起作用。

最后需要修复的是等待。至少有4个原因Do While objIE.Busy = True or objIE.readyState <>4: DoEvents: Loop不起作用：

1. 在导航和等待之后，可以立即触发一个脚本，强制浏览器再次忙碌，因此我们需要再次等待
2. 文档本身需要检查readyState
3. IE 对象可能会断开连接
4. 某些操作后 IE 对象不会更新

要解决此问题，只需将以下代码放入标准代码模块中即可。调用模块LibIE，因为它将充当支持库：

Option Explicit
Option Private Module

Public Enum IEFlags
    navOpenInNewWindow = 1
    navNoHistory = 2
    navNoReadFromCache = 4
    navNoWriteToCache = 8
    navAllowAutosearch = 16
    navBrowserBar = 32
    navHyperlink = 64
    navEnforceRestricted = 128
    navNewWindowsManaged = 256
    navUntrustedForDownload = 512
    navTrustedForActiveX = 1024
    navOpenInNewTab = 2048
    navOpenInBackgroundTab = 4096
    navKeepWordWheelText = 8192
    navVirtualTab = 16384
    navBlockRedirectsXDomain = 32768
    navOpenNewForegroundTab = 65536
End Enum

#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

'Creates an instance of InternetExplorer
Public Function CreateIEBrowser(Optional ByVal mediumSecurity As Boolean = False) As InternetExplorer
    Const maxLoops As Long = 1000
    '
    Dim IE As InternetExplorer
    Dim loopsCount As Long
    '
    'If there is another instance of IE that is trying to shut down, then a new
    '   instance cannot get created and a -2147023706 error is thrown:
    '   "A system shutdown has already been scheduled. Automation Error"
    'If a new instance is not created then loop and wait/pause between tries
    On Error Resume Next
    Do While loopsCount < maxLoops And IE Is Nothing
        If mediumSecurity Then
            Set IE = New InternetExplorerMedium
            'If the library reference is missing then use (late binding):
            'Set IE = CreateObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}")
        Else
            Set IE = New InternetExplorer
            'If the library reference is missing then use (late binding):
            'Set IE = CreateObject("InternetExplorer.Application")
        End If
        loopsCount = loopsCount + 1
        Sleep 10
    Loop
    On Error GoTo 0
    '
    Set CreateIEBrowser = IE
End Function

'Check if IE got disconnected
Public Function IsIEDisconnected(ByVal IE As InternetExplorer) As Boolean
    IsIEDisconnected = (IE Is Nothing) Or (TypeName(IE) = "Object")
End Function

'Waits for an IE browser to be idle
Public Sub WaitIE(ByVal IE As InternetExplorer _
                , Optional ByVal timeoutSeconds As Long = 60 _
)
    If IsIEDisconnected(IE) Then Exit Sub
    If timeoutSeconds < 0 Then timeoutSeconds = 0
    '
    Const waitMilliPerLoop As Long = 10
    Dim maxTotalLoops As Long
    Dim maxInnerLoops As Long
    Dim innerLoopsCount As Long
    Dim outerLoopsCount As Long
    '
    maxTotalLoops = timeoutSeconds * 1000 / waitMilliPerLoop
    maxInnerLoops = maxTotalLoops / 10
    '
    #If VBA7 Then
        Dim storedHandle As LongPtr
    #Else
        Dim storedHandle As Long
    #End If
    '
    'Although the browser may look like it's not busy anymore and the state is
    '   "Complete", it might happen that the page must trigger a script
    'Thus, two loops are required:
    '   - an inner loop to track if IE is busy and ready state is complete
    '     while making sure it times-out after a pre-defined number of loops
    '   - an outer loop which runs the inner loop and then pauses for a few
    '     milliseconds (to allow the scripts on page to fire) and checks the IE
    '     status again
    storedHandle = IE.hwnd
    Do While (IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE _
    ) And outerLoopsCount < maxTotalLoops
        innerLoopsCount = 0
        Do While (IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE) _
        And innerLoopsCount < maxInnerLoops
            Sleep waitMilliPerLoop
            innerLoopsCount = innerLoopsCount + 1
            Set IE = GetIEByHandle(storedHandle)
        Loop
        outerLoopsCount = outerLoopsCount + innerLoopsCount
        Set IE = GetIEByHandle(storedHandle)
    Loop
    Do While IE.Document.ReadyState <> READYSTATE_COMPLETE _
    And outerLoopsCount < maxTotalLoops
        Sleep waitMilliPerLoop
        outerLoopsCount = outerLoopsCount + innerLoopsCount
        Set IE = GetIEByHandle(storedHandle)
    Loop
End Sub

'Returns an Internet Explorer object by providing the window handle
'   (if the handle exists in the collection of opened shell windows)
#If VBA7 Then
Public Function GetIEByHandle(ByVal hwnd As LongPtr) As InternetExplorer
#Else
Public Function GetIEByHandle(ByVal hwnd As Long) As InternetExplorer
#End If
    If hwnd = 0 Then Exit Function
    '
    Dim tempObj As Object
    Dim IE As InternetExplorer
    '
    On Error Resume Next
    For Each tempObj In GetShellWindows()
        If tempObj.hwnd = hwnd Then
            Set IE = tempObj
            Exit For
        End If
    Next tempObj
    On Error GoTo 0
    '
    Set GetIEByHandle = IE
End Function

Private Function GetShellWindows() As ShellWindows
    Const maxLoops As Long = 1000
    '
    Dim collShellWindows As ShellWindows
    Dim loopsCount As Long
    '
    On Error Resume Next
    Do While loopsCount < maxLoops
        Set collShellWindows = New ShellWindows
        If Not collShellWindows Is Nothing Then
            If collShellWindows.Count > 0 Then Exit Do
        End If
        loopsCount = loopsCount + 1
        Sleep 1
    Loop
    On Error GoTo 0
    Set GetShellWindows = collShellWindows
End Function

'Returns the first found opened Internet Explorer instance
Public Function GetOpenedIE() As InternetExplorer
    Const maxLoops As Long = 1000
    '
    Dim tempObj As Object
    Dim IE As InternetExplorer
    '
    On Error Resume Next
    For Each tempObj In GetShellWindows()
        If tempObj.Name = "Internet Explorer" Then
            Set IE = tempObj
            Exit For
        End If
    Next tempObj
    On Error GoTo 0
    '
    Set GetOpenedIE = IE
End Function

'Navigate a URL inside a specific InternetExplorer instance
Public Sub NavigateUrl(ByVal IE As InternetExplorer _
                     , ByVal Url As String _
                     , ByVal flags As IEFlags _
                     , Optional ByVal postData As Variant _
                     , Optional ByVal headers As Variant _
)
    If IsIEDisconnected(IE) Then Exit Sub
    '
    #If VBA7 Then
        Dim storedHandle As LongPtr
    #Else
        Dim storedHandle As Long
    #End If
    '
    'The Navigate command (depending on configuration and IE security) causes the
    '   IE object to lose the reference to the actual instance of InternetExplorer
    storedHandle = IE.hwnd
    '
    IE.Navigate Url:=Url, flags:=flags, postData:=postData, headers:=headers
    Sleep 10
    '
    'Please note that the initial window might have been destroyed
    '   and a new one created (with a new handle) which requires a different approach,
    '   like storing a collection of window handles from ShellWindows collection
    '   (before Navigate command) and comparing them with the handles after the
    '   Navigate command. Not implemented
    Set IE = GetIEByHandle(storedHandle)
End Sub

这是使用上述LibIE库的演示方法：

Option Explicit

Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
Const SW_MAXIMIZE As Long = 3

Sub Demo()
    Dim IE As InternetExplorer
    Dim flags As IEFlags: flags = navNoHistory + navNoReadFromCache + navNoWriteToCache 'Or whatever you need
    '
    On Error GoTo ErrorHandler
    Set IE = LibIE.CreateIEBrowser(mediumSecurity:=False)
    '
    'Maybe try medium security settings
    'If IE Is Nothing Then Set IE = LibIE.CreateIEBrowser(mediumSecurity:=True) 'Uncomment if needed!
    '
    'Maybe get an already opened instance
    'If IE Is Nothing Then Set IE = LibIE.GetOpenedIE() 'Uncomment if needed!
    '
    If IE Is Nothing Then
        MsgBox "Cannot create IE"
        Exit Sub
    End If
    '
    IE.Visible = True
    IE.Silent = True
    '
    'Maybe Maximize
    'ShowWindow IE.hwnd, SW_MAXIMIZE 'Uncomment if needed!
    '
    LibIE.NavigateUrl IE, "https://myturnvolunteer.ca.gov/s/#search", flags
    LibIE.WaitIE IE
    '
    Dim doc As HTMLDocument
    Set doc = IE.Document
    '
    With doc.getElementsByClassName("slds-form")(0)
        .elements("input-13").Value = "MyFirstName"
        .elements("input-14").Value = "MyLastName"
        .elements("input-15").Value = "MyZipCode"
        .elements("input-16").Value = "MyEMail"
        .elements("input-17").Value = "MyPhone"
        .elements("agreedToTermsConditions").Checked = True
    End With
    '
    Stop 'Go and inpect the results in the browser!
Clean:
    If Not LibIE.IsIEDisconnected(IE) Then IE.Quit
Exit Sub
ErrorHandler:
    Resume Clean
End Sub

我添加了一些额外的行，您可以取消注释以获得已打开的 IE 浏览器或最大化 IE 窗口。