Excel VBA 麻烦填写 web 文本框

Question

I am trying to enter text into a textbox on a webpage.

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

I am using this line in my excel macro to try to pull enter "test" in that box:

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

This code works for other sites but I can't figure out why it doesn't work for the object above.

Full code:

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

After navigating to your webpage and waiting for it to load, if you run this line of code:

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

You will see that in the Immediate Window you get something like JScriptTypeInfo when in fact you were expecting a DispHTMLElementCollection .

To fix this you will need to add a reference to Microsoft HTML Object Library . If you don't have it in the list then simply browse for mshtml.tlb type library:

Now the above line of code could become:

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

which now prints DispHTMLElementCollection correctly to the immediate window.

If you use the doc variable, all the functionality like doc.getElementsByClassName or doc.getElementById will work.

Last thing that needs fixing is the waiting. There are at least 4 reasons why Do While objIE.Busy = True or objIE.readyState <>4: DoEvents: Loop does not work:

1. Immediately after navigating and waiting, a script can be triggered that forces the browser to be busy again so we need to wait again
2. The document itself needs to be checked for readyState
3. The IE Object can get disconnected
4. The IE Object does not get updated after certain actions

To fix this, just drop the following code into a standard code module. Call the module LibIE as it will act as a supporting library:

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

Here is a demo method that uses the above LibIE library:

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

I've added some extra lines that you can uncomment for getting an already opened IE browser or maximizing the IE window.

Answer 2

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
   Application.Wait DateAdd("s", 7, Now)

   For i = 1 To objIE.Document.all.Length - 1
        itmName = objIE.Document.all.Item(i).ID
        Set target = objIE.Document.all.Item(i)
        
        Select Case itmName
        
            Case "input-13" 'First Name
            target.Value = "My First Name"
            
            Case "input-14" 'Last Name
            target.Value = "My Last Name"
        
            Case "input-15" 'Zip Code
            target.Value = "111111"
            
            Case "input-16" 'Mail
            target.Value = "mymail@gmail.com"
            
            Case "input-17" 'Phone
            target.Value = "111111"
        End Select
   Next i

End Sub

Answer 3

Yes. I'am out here;-)

After the most ideas I had, I'am sure... This page isn't to automate or I'am completly incompetent. Another chance of my failure is that the page only works in Canada. Now I give up.

1. When I try your script I run into an error. You wrote it works for you but I already get an error in the line objIE.document.all.Item("radioButtonGroup")(1).Click
2. I found out... Do While objIE.Busy = True or objIE.readyState <>4: DoEvents: Loop don't work for me. Realy for you it does? You get the whole HTML code of the page at once?
3. I replaced the code line with a loop until the body tag was found

This is what I got:

 <body class="null loading"> <div class="auraMsgBox auraLoadingBox" id="auraLoadingBox"> <div class="logo"></div> <div class="spinner"></div><span>Loading</span> </div> <div id="auraErrorMask"> <div class="auraErrorBox" id="auraError"><span><a class="close" id="dismissError">×</a>Sorry to interrupt</span> <div id="auraErrorMessage">CSS Error</div> <div id="auraErrorStack"></div> <div class="auraErrorFooter"><a id="auraErrorReload" href="?">Refresh</a></div> </div> </div> <script data-src="/jslibrary/1615500424000/canvas/CanvasRendering.js"></script> <script data-src="/jslibrary/1615500424000/ui-analytics-reporting/EclairNG.js"></script> <script src="/s/sfsites/l/%7B%22mode%22%3A%22PROD%22%2C%22app%22%3A%22siteforce%3AcommunityApp%22%2C%22fwuid%22%3A%22Q8onN6EmJyGRC51_NSPc2A%22%2C%22loaded%22%3A%7B%22APPLICATION%40markup%3A%2F%2Fsiteforce%3AcommunityApp%22%3A%224cm95xKNoonR9yZ2JR2osw%22%7D%2C%22apce%22%3A1%2C%22apck%22%3A%22u9iioD98ab206u8hlyEMmg%22%2C%22mlr%22%3A1%2C%22pathPrefix%22%3A%22%22%2C%22dns%22%3A%22c%22%2C%22ls%22%3A1%2C%22ct%22%3A1%7D/inline.js?aura.attributes=%7B%22schema%22%3A%22Published%22%2C%22brandingSetId%22%3A%22f5c37b15-72c4-4421-af84-37960d2fa7e0%22%2C%22authenticated%22%3A%22false%22%2C%22ac%22%3A%22%22%2C%22formFactor%22%3A%22LARGE%22%2C%22publishedChangelistNum%22%3A%2227%22%2C%22viewType%22%3A%22Published%22%2C%22themeLayoutType%22%3A%22nAtCOQTE4aYQruDNHEwADFuctWEGBf%22%2C%22language%22%3A%22en_US%22%2C%22isHybrid%22%3A%22false%22%2C%22pageId%22%3A%224d72295e-92a7-4b09-9a8d-fe789ec4b457%22%7D"></script> <script src="/s/sfsites/l/%7B%22mode%22%3A%22PROD%22%2C%22app%22%3A%22siteforce%3AcommunityApp%22%2C%22fwuid%22%3A%22Q8onN6EmJyGRC51_NSPc2A%22%2C%22loaded%22%3A%7B%22APPLICATION%40markup%3A%2F%2Fsiteforce%3AcommunityApp%22%3A%224cm95xKNoonR9yZ2JR2osw%22%7D%2C%22apce%22%3A1%2C%22apck%22%3A%22u9iioD98ab206u8hlyEMmg%22%2C%22mlr%22%3A1%2C%22pathPrefix%22%3A%22%22%2C%22dns%22%3A%22c%22%2C%22ls%22%3A1%2C%22ct%22%3A1%7D/resources.js?pv=16158482120001346086951&amp;rv=1615910240000"></script> </body>

4. That is a part of the HTML code after the opening body tag. So I thought I give it a little time to get the whole html code. I do so and was very happy when I get the whole code for the body
5. Now I tried to got all input tags. But I got the same error like before instead. It seemed there are no input tags. but if I looked into the grabbed HTML code everthing was there. Very mysterious
6. With the same VBA code I got sometimes the body and sometimes not. What is wrong with that page? It's not possible for me to get same results with the same action. I don't know why. But like I wrote... Now I give up

This is my last VBA code to try something:

Private Sub FillHtmlForm()
  
  Const url = "https://myturnvolunteer.ca.gov"
  Dim ie As Object
  Dim nodeBody As Object
  Dim nodeInput As Object
  Dim timeOutStart As Double
  
  'Create Internet Explorer
  Set ie = CreateObject("InternetExplorer.Application")
  ie.Visible = True
  ie.navigate url
  'Do While ie.readyState <> 4: DoEvents: Loop
  timeOutStart = Timer
  
  Do
    On Error Resume Next
    Set nodeBody = ie.document.getElementsByTagName("body")(0)
    On Error GoTo 0
    DoEvents
    If Not nodeBody Is Nothing Then
      If InStr(1, nodeBody.innertext, "Sorry to interrupt") > 0 Then
        Application.Wait (Now + TimeSerial(0, 0, 5))
      End If
    End If
  Loop Until Not nodeBody Is Nothing Or Timer - timeOutStart > 15 'Timeout in seconds
  
  If Not nodeBody Is Nothing Then
    Set nodeInput = nodeBody.getElementsByTagName("input")
    MsgBox nodeInput.Length 'I get an error here
  Else
    MsgBox "No body ;-)" 'Sometimes this occours with the same code without timeout
  End If
End Sub

Like QHarr wrote the code of the page seems to be in progress. Yor HTML snippet has a PlaceHolder but in the HTML of the current page are no place holders in use.