通过 IE 向在线 MS 表单提交数据不起作用

Question

谁能找出我做错了什么？

当我尝试向在线 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

Answer 1

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

这是我的经验：你花了很多时间试图解决这种 'what happened the click was supposed to work' 错误。或者为什么页面没有加载一路错误？或者我如何等待页面加载并单击它需要的内容。

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

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

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

Source

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

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

编辑示例：

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

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

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

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

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

思路四：填一个方框

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

思路五：等待加载

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

祝你好运！

Answer 2

我尝试使用 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

输出：

通过 IE 向在线 MS 表单提交数据不起作用

Submitting data via IE to an online MS Form is not working

excel

internet-explorer

vba

ms-forms