0

谁能弄清楚我做错了什么？

当我尝试将数据提交到在线 MS 表单时，单击提交按钮时提交失败，因为输入文本框中的数据消失了。

我正在使用的代码：

Sub Hello()

    Dim objIE As Object
    Dim URL As String
    Dim doc As HTMLDocument

    Dim oServ As Object
    Dim cProc As Variant
    Dim oProc As Object

    URL = "https://forms.office.com/Pages/ResponsePage.aspx?id=1tUOxOPgeU2DDHmR8zp8jnPOq1Zxq2ZMgF9BFdtxEI9UNTJUSlpaNVU3S0pYRDI0MzE3UkZZQzdZNi4u"

    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Visible = True
    objIE.navigate URL
    Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
    Set doc = objIE.document

    Set oServ = GetObject("winmgmts:")
    Set cProc = oServ.ExecQuery("Select * from Win32_Process")

    Dim input_text As String
    input_text = "Hello!"

    doc.getElementsByTagName("input")(0).Value = input_text
    doc.getElementsByTagName("input")(0).setAttribute("value") = input_text

    'Let us wait 5 secconds to see if the text was entered into the textbox
    Application.Wait (Now() + TimeValue("00:00:05"))

    doc.getElementsByTagName("button")(2).Click


    'Let us wait 10 secconds to see the results before terminating IE
    Application.Wait (Now() + TimeValue("00:00:10"))


    Set objIE = Nothing
    For Each oProc In cProc
      If oProc.Name = "iexplore.exe" Then
          'MsgBox "KILL"   ' used to display a message for testing pur
          oProc.Terminate  'kill exe
      End If
    Next

End Sub
4

2 回答 2

0

我不建议使用 IE 来自动提交 VBA 表单。

这是我的经验：您花了很多时间试图解决这种“点击应该起作用的情况”错误。或者为什么页面没有加载一路错误？或者我如何等​​待页面加载并单击它需要的内容。

TBS：花了太多时间试图让这种事情发挥作用，而且经常得到很好的结果。我建议在页面上使用您的 DevTools（IE 中的 f12）。首先正常点击按钮，看看会发生什么。Next 单击控制台部分中使用 JavaScript 运行的按钮。这将与您的单击语法非常相似。记下使用开发工具中的检查器实际单击了哪些元素以及随事件运行的脚本。

IE 确实有办法在页面上运行确切的 javascript，您可能需要使用以下语法复制表单点击事件和 javascript：

 Call IE.document.parentWindow.execScript("document.all.myElement.focus();buttonMovimenti();", "JavaScript")

资源

我使用 execScript 触发 OnClick() 取得了更大的成功；页面/父窗口上的事件。请记住，iFrame 可能很难确定您选择的是哪个文档，因此请务必检查源代码以查看测试页面上是否有多个 html 文档。

或者，您可以尝试使用 HTTP post/get 方法使用 VBA 的 MSXML2.XMLHTTP 请求对象提交表单，并在单击按钮时复制您在“网络”选项卡下的 DevTools 中看到的标题/表单提交。这将使页面加载的时间排除在外，并进行更简化的提交。

编辑示例：

这是我用来执行脚本的子程序。

首先在 IE 的控制台中测试脚本。在您的评论中，您引用了整个最小化的 JS 库。您要做的是从执行表单提交的窗口中找到该功能。

Public Sub RunScriptZ(IeObjectDoc As Object, sJavaScript As String)
'run any java script on a page

    Dim CurrentWindow As HTMLWindowProxy
    Set CurrentWindow = IeObjectDoc.parentWindow
    Call CurrentWindow.execScript(sJavaScript)


End Sub

通常一个表单是用一个基本的函数提交的，比如'submitForm()'。因此，在页面打开的情况下打开 DevTools，然后转到控制台，然后键入 Document.submitForm(); 在控制台中，看看会发生什么。希望表单与此一起提交。然后你可以这样：

 Call RunScriptZ(objie.Document, "submitForm()")

如果这不起作用，有时网站需要您单击/悬停以提交表单。您可以单独或组合尝试这些变体，看看它是否在网页上复制。

思路一，火灾事件法

Dim ieo As New SHDocVw.InternetExplorerMedium
Set ieoDoc = ieo.Document
ieoDoc.getElementById("buttonId").FireEvent ("Onclick")

想法 2：基本执行脚本

Dim ieo As New SHDocVw.InternetExplorerMedium
Set ieoDoc = ieo.Document
Dim CurrentWindow As HTMLWindowProxy
Set CurrentWindow = ieoDoc.parentWindow
Call CurrentWindow.execScript("submitForm()") ''or whatever the JS function 
'name is that runs in console and triggers the event

想法3：测试按钮是否可点击。有时用编程填写的网络表单，不要注册为填写，特别是如果你只是分配值。我知道我处理过的很多表单都需要在输入上单击事件才能注册发生的更改，因此请检查提交按钮以确保它甚至可以使用以下代码单击：

Public Function TestLinkClick(linkelement As HTMLButtonElement, ForceClick 
As Boolean) As Boolean
 If ForceClick = True Then GoTo clickawaylabel

   If IsNull(linkelement.OnClick) = False Then
clickawaylabel:
    TestLinkClick = True
    Debug.Print "the link is clickable"
    Else 'the linkelement is not clickable

      TestLinkClick = False
       Debug.Print "the link is not clickable"

    End If

 End Function

想法4：填写一个方框

Public Sub FillInBox(TextValue As String, BoxName As String, IECVdoc As Object)

'fill in a box on a html page
Dim tries As Integer
tries = 0

On Error GoTo errorhandler

If tries >= 3 Then GoTo HappyEnd

startAgain:
With IECVdoc
    .getElementById(BoxName).Value = TextValue
    .getElementById(BoxName).FireEvent ("onchange")
End With

GoTo HappyEnd
errorhandler:

''Call a wait timer I'm using a wait sub: WaitForLoadSETx(IECVdoc, 2, 3)
tries = tries + 1
GoTo startAgain

HappyEnd:
End Sub

想法 5：等待加载

Public Sub WaitForLoadSETx(ieo As Object, Maxtime As Integer, Maxtime2 As Integer)
' Wait for page to load before continuing

Dim sngTime As Single

'Const Maxtime As Integer = 5
'Const Maxtime2 As Integer = 10
    sngTime = VBA.Timer ' a snapshot of the timer at the time the subroutine starts



    ' Wait until the webpage is doing something ...                'READYSTATE_COMPLETE <<< replaced 9/16/13 to click quicker with interactive
    Do Until ieo.ReadyState <> READYSTATE_COMPLETE
        DoEvents
        If VBA.Timer > sngTime + Maxtime And VBA.Left(ieo.statusText, 4) = "Done" Then Exit Sub
        If VBA.Timer > sngTime + Maxtime2 And ieo.ReadyState = 4 Or ieo.ReadyState = "complete" Then Exit Sub 'added this to make a real max time 1-12-15 'aded OR complete 1/14/15
     '   If VBA.Left(IEo.StatusText, 4) = "" Then GoTo outloop
     Debug.Print "ONE LOOP Page Loading [" & VBA.Timer & "]/[" & sngTime + Maxtime & "]" & " [" & ieo.ReadyState & "]" & " [" & ieo.statusText & "]"  '<<<< added 1/02/14
    Loop
'outloop:
    ' ... and then wait for it to finish 'READYSTATE_INTERACTIVE  <<< replaced 9/18/13 to click quicker with interactive
    Do Until ieo.ReadyState = READYSTATE_COMPLETE
        DoEvents
        On Error GoTo 0
       ' If VBA.Timer > sngTime + Maxtime And VBA.Left(ieo.statusText, 4) = "Done" Then Exit Sub 'removed 1/14/15 because or error 438 not found on .statusText
        If VBA.Timer > sngTime + Maxtime2 And ieo.ReadyState = 4 Or ieo.ReadyState = "complete" Then Exit Sub 'added this to make a real max time 1-12-15 'aded OR complete 1/14/15
    Debug.Print "TWO LOOP Page Loading [" & VBA.Timer & "]/[" & sngTime + Maxtime & "]" & " [" & ieo.ReadyState & "]" '& " [" & 'ieo.statusText & "]" '<<<< added 1/02/14
    Loop

0:
End Sub

祝你好运！

于 2020-01-13T17:32:40.723 回答
0

我尝试使用 Sendkeys() 并解决了这个问题。

您需要替换这些代码行。

doc.getElementsByTagName("input")(0).Value = input_text
doc.getElementsByTagName("input")(0).setAttribute("value") = input_text

与下面的代码行。

doc.getElementsByTagName("input")(0).Focus
SendKeys (input_text)

完整修改代码：

Sub Hello()

    Dim objIE As Object
    Dim URL As String
    Dim doc As HTMLDocument

    Dim oServ As Object
    Dim cProc As Variant
    Dim oProc As Object

    URL = "https://forms.office.com/Pages/ResponsePage.aspx?id=1tUOxOPgeU2DDHmR8zp8jnPOq1Zxq2ZMgF9BFdtxEI9UNTJUSlpaNVU3S0pYRDI0MzE3UkZZQzdZNi4u"

    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Visible = True
    objIE.navigate URL
    Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
    Set doc = objIE.document

    Set oServ = GetObject("winmgmts:")
    Set cProc = oServ.ExecQuery("Select * from Win32_Process")

    Dim input_text As String
    input_text = "Hello!"

   ' doc.getElementsByTagName("input")(0).Value = input_text
   ' doc.getElementsByTagName("input")(0).setAttribute("value") = input_text

   doc.getElementsByTagName("input")(0).Focus
   SendKeys (input_text)

    'Let us wait 5 secconds to see if the text was entered into the textbox
    Application.Wait (Now() + TimeValue("00:00:05"))

    doc.getElementsByTagName("button")(2).Click


    'Let us wait 10 secconds to see the results before terminating IE
    Application.Wait (Now() + TimeValue("00:00:10"))


    Set objIE = Nothing
    For Each oProc In cProc
      If oProc.Name = "iexplore.exe" Then
          'MsgBox "KILL"   ' used to display a message for testing pur
          oProc.Terminate  'kill exe
      End If
    Next

End Sub

输出：

在此处输入图像描述

于 2020-01-14T02:45:10.013 回答