单击提交按钮后，VBA 从旧页面读取 HTML

Question

我不是程序员，但我已经设法在 VBA 中学习了一些东西，但现在在某个网站上我遇到了其他网站上不存在的问题。

应该发生的是页面表单应该用数据完成，单击提交按钮，然后我想从结果页面获取一些数据。

第一阶段工作正常，但似乎无论我做什么，VBA 仍然会在点击提交之前从页面读取数据。

代码是：

Sub VIES2()

'Uruchomienie Internet Explorera i wstrzymanie dalszej akcji aż uzyska stan gotowości
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate "http://ec.europa.eu/taxation_customs/vies/?locale=pl"

Do While IE.ReadyState <> 4: DoEvents: Loop

'Wypełnienie formularza odpowiednimi wartościami i kliknięcie przycisku sprawdzenia
IE.document.getElementbyId("countryCombobox").Value = "IT"
IE.document.getElementbyId("number").Value = "01802840023"
IE.document.getElementbyId("requesterCountryCombobox").Value = "IT"
IE.document.getElementbyId("requesterNumber").Value = "01802840023"
IE.document.getElementbyId("submit").Click

'Test uzyskiwania opisu i identyfikatora zapytania

For t = 1 To 999999
Next t

Application.Wait Now + TimeValue("00:00:10")

Do While IE.ReadyState <> 4: DoEvents: Loop

For t = 1 To 999999
Next t

Application.Wait Now + TimeValue("00:00:10")

MsgBox IE.LocationURL

Set Text = IE.document.getElementsbyClassName("layout-content")

For Each Element In Text
MsgBox Element.innerText
Next

Set Test = IE.document.getElementsbyTagName("TABLE")

For Each Element In Test
MsgBox Element.innerText
Next

End Sub

我已尝试按照类似问题中的建议将中断、各种等待循环和 Application.Wait 放在似乎有效的地方。在这里，即使页面在完全加载后很长时间后，代码仍然会读取旧页面 - 至少拉取 URL 并且一些数据似乎表明是这种情况。

更新：我还应该补充一点，我试图让宏刷新页面，但它会清除输入内容。目标 URL 的有趣之处在于：

http://ec.europa.eu/taxation_customs/vies/vatResponse.html

如果我将初始页面更改为此，浏览器会立即重定向到原始页面，并通知需要初始数据。然后宏完成数据并单击提交按钮。在这种情况下 IE.LocationURL 表示这个 URL：

http://ec.europa.eu/taxation_customs/vies/vatResponse.html

但根据我使用 getElementsbyClassName 得到的内容，仍然会从初始页面读取元素：

http://ec.europa.eu/taxation_customs/vies/?locale=pl

Answer 1

这可以打印出增值税响应表

注意：

如果在 32 位上删除 PtrSafe。

代码：

Option Explicit
Declare PtrSafe Sub sleep Lib "kernel32" Alias "Sleep" (ByVal dwmilliseconds As Long)

Public Sub VIES2()
    Application.ScreenUpdating = False
    Dim IE As Object

    'Uruchomienie Internet Explorera i wstrzymanie dalszej akcji az uzyska stan gotowosci
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    IE.navigate "http://ec.europa.eu/taxation_customs/vies/?locale=pl"

    Do While IE.ReadyState <> 4: DoEvents: Loop

    'Wypelnienie formularza odpowiednimi wartosciami i klikniecie przycisku sprawdzenia
    IE.document.getElementById("countryCombobox").Value = "IT"
    IE.document.getElementById("number").Value = "01802840023"
    IE.document.getElementById("requesterCountryCombobox").Value = "IT"
    IE.document.getElementById("requesterNumber").Value = "01802840023"
    IE.document.getElementById("submit").Click

    sleep (5000) 'or increase to 10000
    Dim tbl  As Object

    Set tbl = IE.document.getElementById("vatResponseFormTable")

    Dim ws As Worksheet
    Set ws = ActiveWorkbook.Worksheets.Add
    ws.Name = "Results"
    Dim rng As Range, currentRow As Object, currentColumn As Object, i As Long, outputRow As Long

        outputRow = outputRow + 1
        Set rng = ws.Range("B" & outputRow)

        For Each currentRow In tbl.Rows
            For Each currentColumn In currentRow.Cells
                rng.Value = currentColumn.outerText
                Set rng = rng.Offset(, 1)
                i = i + 1
            Next currentColumn
            outputRow = outputRow + 1
            Set rng = rng.Offset(1, -i)
            i = 0
        Next currentRow
        Application.ScreenUpdating = True
End Sub

输出：

Answer 2

虽然 QHarr 的解决方案对我来说是有效的，但我在脚本中提供了另一个没有硬编码延迟的解决方案。

使用 IE 作为您的问题是：

Sub Get_Data()
    Dim HTML As HTMLDocument, post As Object, elems As Object
    Dim elem As Object, r&, c&

    With New InternetExplorer
        .Visible = False
        .navigate "http://ec.europa.eu/taxation_customs/vies/?locale=pl"
        While .Busy = True Or .readyState < 4: DoEvents: Wend
        Set HTML = .document

        With HTML
            .getElementById("countryCombobox").Value = "IT"
            .getElementById("number").Value = "01802840023"
            .getElementById("requesterCountryCombobox").Value = "IT"
            .getElementById("requesterNumber").Value = "01802840023"
            .getElementById("submit").Click

            Do: Set post = .getElementById("vatResponseFormTable"): DoEvents: Loop While post Is Nothing

            For Each elems In post.Rows
                For Each elem In elems.Cells
                    c = c + 1: Cells(r + 1, c) = elem.innerText
                Next elem
                c = 0: r = r + 1
            Next elems
        End With
        .Quit
    End With
End Sub

添加到库的参考：

1. Microsoft Internet Controls
2. Microsoft HTML Object Library

使用xmlhttp请求（比IE快很多）：

Sub Get_Data()
    Dim elems, elem As Object
    Dim QueryString$, S$, r&, c&

    QueryString = "memberStateCode=IT&number=01802840023&traderName=&traderStreet=&traderPostalCode=&traderCity=&requesterMemberStateCode=IT&requesterNumber=01802840023&action=check&check=Weryfikuj"

    With New XMLHTTP
        .Open "POST", "http://ec.europa.eu/taxation_customs/vies/vatResponse.html", False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send QueryString
        S = .responseText
    End With

    With New HTMLDocument
        .body.innerHTML = S

        For Each elems In .getElementById("vatResponseFormTable").Rows
            For Each elem In elems.Cells
                c = c + 1: Cells(r + 1, c) = elem.innerText
            Next elem
            c = 0: r = r + 1
        Next elems
    End With
End Sub

添加到库的参考：

1. Microsoft XML, V6
2. Microsoft HTML Object Library

Answer 3

大多数情况下，您应该搜索是否没有可用的 REST/SOAP 来完成此类任务。 为此使用Internet Explorer 实例完全是矫枉过正。

试试这个简单的函数，它使用SOAP 服务来验证增值税号：

Function IsVatValid(country_code, vat_number)

Dim objHTTP         As Object
Dim xmlDoc          As Object

Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
sURL = "http://ec.europa.eu/taxation_customs/vies/services/checkVatService"

sEnv = "<s11:Envelope xmlns:s11='http://schemas.xmlsoap.org/soap/envelope/'>" & _
               "<s11:Body>" & _
                    "<tns1:checkVat xmlns:tns1='urn:ec.europa.eu:taxud:vies:services:checkVat:types'>" & _
                    "<tns1:countryCode>" & country_code & "</tns1:countryCode>" & _
                    "<tns1:vatNumber>" & vat_number & "</tns1:vatNumber>" & _
                    "</tns1:checkVat>" & _
               "</s11:Body>" & _
               "</s11:Envelope>"


objHTTP.Open "Post", sURL, False
objHTTP.setRequestHeader "Content-Type", "text/xml"
objHTTP.setRequestHeader "SOAPAction", "checkVatService"
objHTTP.send (sEnv)
objHTTP.waitForResponse

Set xmlDoc = CreateObject("HTMLFile")
xmlDoc.body.innerHTML = objHTTP.responsetext

IsVatValid = CBool(xmlDoc.getElementsByTagName("valid")(0).innerHTML)

Set xmlDoc = Nothing
Set objHTTP = Nothing

End Function

然后您可以简单地验证所有增值税号：

Debug.Print IsVatValid("IT", "01802840023")
>>> True