html - Excel VBA在填写Web文本框时遇到问题
问题描述
我正在尝试在网页上的文本框中输入文本。
<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
解决方案
导航到您的网页并等待它加载后,如果您运行这行代码:
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
ordoc.getElementById
将起作用。
最后需要修复的是等待。至少有4个原因Do While objIE.Busy = True or objIE.readyState <>4: DoEvents: Loop
不起作用:
- 在导航和等待之后,可以立即触发一个脚本,迫使浏览器再次忙碌,所以我们需要再次等待
- 文档本身需要检查readyState
- IE 对象可能会断开连接
- 某些操作后 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 窗口。
推荐阅读
- python - 我正在尝试将一些数据存储到文本文件中,没有错误,但它写入“.!toplevel.!entrywrite”而不是用户输入
- python - 在 Excel 中重现 Mann-Whitney U
- c - 将获取 arry 字符的函数转换为获取 char * 的函数
- mysql - 从订单商品中提取 SKU 的 SQL (Woocommerce - Wordpress)
- android - 使用 kotlin 构建 android 应用程序时抛出异常“后端(JVM)内部错误:生成错误的字节码”
- ios - 突然间无法为 Ios 构建 Ionic Cordova
- pytorch - 如何将 torch.norm 转换为余弦距离
- tensorflow - Gstreamer:如何读取元素属性内的结构
- postgresql - 将 oracle Reference 触发器转换为 postgreSQL 触发器
- video - 当从 withUIImagePickerController 或 PHPickerViewController 使用的照片库中选择视频时,与 AirDrop 共享的 HDR 视频的 mediaURL 为零