Question

以下代码在完成位于网页上的表单时效果很好。提交表格时会出现问题。

这似乎是验证的一个问题，因为当系统完成表单时，提交按钮被禁用。但是，当我返回文本框并手动输入完全相同的信息时，提交按钮随后可用。我认为表单认为它不完整，因此禁用了提交按钮。我甚至使用SubmitBtn.disabled = False系统地重新启用此按钮（允许手动或系统地点击它），它仍然不会提交。

填写网页时，我从未遇到过这种类型的表单验证。

我目前使用的是Internet Explorer 11

以下代码已完成，无需修改即可进行测试。这是一个向公众开放的网站

Option Explicit

#If VBA7 Then
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub SCRA_Scrub()

    ' #################################################
    ' #### LATE BINDING IS REQUIRED ON ALL OBJECTS ####
    ' #################################################

    Dim IE As Object

    Dim sSSN As String, sLastName As String, sFirstName As String
    sSSN = "123456789"
    sLastName = "DOE"
    sFirstName = "JOHN"

    Set IE = GetIE("scra.dmdc.osd.mil") 'Already Open
    If IE Is Nothing Then
        Set IE = CreateObject("InternetExplorer.Application")   'Not open
        With IE
            .Visible = True
            .Navigate ("https://scra.dmdc.osd.mil/scra/#/single-record")
        End With
    Else    'Reset form
        Dim ClearBtn As Object
        Set ClearBtn = IE.document.getElementsByClassName("btn btn-primary")(0)
    End If
    Sleep 400
    Dim oSSN As Object, oSSN2 As Object, oLastName As Object, oFirstName As Object, SubmitBtn As Object
    Dim oCaptcha As Object
    Do While IE.Busy Or IE.ReadyState <> 4
        DoEvents
    Loop

    'For some reason, page shows loaded when it's not. Will loop until obj
    'becomes available
    On Error Resume Next
    Do Until Not oSSN Is Nothing And Not oCaptcha Is Nothing
        Set oSSN = IE.document.getElementByID("ssnInput")
        Set oCaptcha = IE.document.getElementByID("recaptcha_response_field")
        DoEvents
    Loop
    On Error GoTo 0
    Set oSSN2 = IE.document.getElementByID("ssnConfirmationInput")
    Set oLastName = IE.document.getElementByID("lastNameInput")
    Set oFirstName = IE.document.getElementByID("firstNameInput")

    oSSN.InnerText = sSSN
    oSSN2.InnerText = sSSN
    oLastName.InnerText = sLastName
    oFirstName.InnerText = sFirstName
    IE.document.ParentWindow.Scroll 0&, 710&
    oCaptcha.InnerText = InputBox("Security answer (Captcha)")
    'IE.Document.Forms(0).submit
    Set SubmitBtn = IE.document.getElementsByClassName("btn btn-primary")(1)
    SubmitBtn.disabled = False '< The button was disabled, but still doesn't submit
    SubmitBtn.Click

End Sub

Function GetIE(sLocation As String) As Object

    Dim objShell As Object, objShellWindows As Object, o As Object
    Dim sURL As String
    Dim RetVal As Object

    Set RetVal = Nothing
    Set objShell = CreateObject("shell.application")
    Set objShellWindows = objShell.Windows

    For Each o In objShellWindows
        sURL = ""
        On Error Resume Next
        sURL = o.document.Location
        On Error GoTo 0
        If sURL Like "*" & sLocation & "*" Then
            Set RetVal = o
            Exit For
        End If
    Next o

    Set GetIE = RetVal

End Function

Answer 1

感谢some assistance，在设置每个输入对象的文本之前，我需要使用object.setActive在此特定表单上显示。

所以代码结束如下：

oSSN.setActive
oSSN.InnerText = sSSN
oSSN2.setActive
oSSN2.InnerText = sSSN
oLastName.setActive
oLastName.InnerText = sLastName
oFirstName.setActive
oFirstName.InnerText = sFirstName
IE.document.ParentWindow.Scroll 0&, 710&
oCaptcha.setActive
oCaptcha.InnerText = InputBox("Security answer (Captcha)")

HTML表单无法提交，可能是表单验证问题

1 个答案: