在加载的网页上点击锚标签按钮,然后点击 Ok 按钮与 vba.



我有以下代码加载网页。我想在加载的网页上单击"高级搜索"锚标签,然后点击"确定"按钮。

Option Explicit
Sub SaveHTml()
Dim str1, str2, str3, str4, str5, str6, str7, URL As String
Dim ie, frm As Object
Dim i As Long
Dim filename As String
Dim FF As Integer
'Dim elems As IHTMLInputTextElement
Dim wb As WebBrowser
Dim objElement As Object
Dim objCollection As Object
Dim Button As Object
'On Error Resume Next
Application.ScreenUpdating = False
str1 = Sheets("PR_data_with_search").Range("F10").Value
str2 = Sheets("PR_data_with_search").Range("I10").Value
URL = "https://webtac.industrysoftware.automation.com/webpr/webpr.php?objtype=frames" 'for TEST
filename = "C:Users" & Environ("UserName") & "DesktopTest.htm"
Set ie = CreateObject("Internetexplorer.Application")
ie.Visible = True
ie.Navigate URL
Do Until ie.ReadyState = 4
DoEvents
Loop
Set ie = Nothing
' load next web page
Dim i1 As Integer
Dim txt, p As String, link As String
txt = "Advanced Search"
Do Until link = txt
    i1 = i1 + 1
    p = ie.Document.Links(i1).tostring
    link = Right(p, 6)
Loop
ie.Document.Links(i).Click
ie.Document.getelementsbyname("openedFrom_dateText")(0).Value = str1
ie.Document.getelementsbyname("openedTo_dateText")(0).Value = str2
'Call ie.Document.getElementsByTagName("ok").Item(1).Click
Set Button = ie.Document.getElementById("ok")
Button.Click
Do
Loop While ie.Busy
CreateObject("Scripting.FileSystemObject").CreateTextFile filename
Do Until ie.ReadyState = 4
DoEvents
Loop
FF = FreeFile
Open filename For Output As #FF
With ie.Document.body
    Print #FF, .outerHTML & .innerHTML
End With
Close #FF
ie.Quit
Set ie = Nothing
Application.ScreenUpdating = True
End Sub

高级搜索锚标记的 html 代码为:

<li><a href="javascript:parent.gotoSearch('advanced')">Advanced Search</a></li>

对于网页上的确定按钮是:

<input type=button name="ok" id="ok" value=" OK " onClick="onSubmitFunction()">

您可以引入额外的显式等待并确保循环直到页面加载

ie.document.querySelector("a[href='javascript:parent.gotoSearch('advanced')']").Click
While IE.Busy Or IE.readyState < 4: DoEvents: Wend
Application.Wait Now + TimeSerial(0,0,2) '<== uncomment this for additional wait time. Change 2 to other # of seconds as required.
ie.document.getElementById("ok").Click

或者,循环直到设置元素(可能还应该添加超时(:

 Do
    DoEvents
    Dim a As Object
    On Error Resume Next
    Set a = IE.document.getElementById("ok")
    On Error GoTo 0
 Loop While a Is Nothing

最新更新