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

I am not a programmer but I have managed to learn just a few things in VBA but now on a certain website I face a problem that does not exist on some other.

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

What should happen is that a page form should be completed with data, submit button clicked and then I want to get some data from the result page.

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

The first phase works fine but it seems that no matter what I do the VBA still reads data from the page before submit was clicked.

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

The code is:

代码是:

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

I have tried putting break, various wait loops and Application.Wait as suggested in similar questions where it seems to have worked. Here, even after the page is long after fully loaded the code still reads the old page - at least pulling the URL and some data seems to point that it is the case.

我试过把断点,各种等待循环和Application.Wait建议在似乎有效的类似问题中。在这里,即使在完全加载后页面很长,代码仍然会读取旧页面 - 至少拉动URL,一些数据似乎指出是这种情况。

UPDATE: I should also add that I have tried to make the macro refresh the page but it clears the input content. What is interesting that target URL is:

更新:我还应该补充一点,我已经尝试使宏刷新页面,但它清除了输入内容。目标URL的有趣之处在于:

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

If I change the initial page to this the browser instantly redirects to the original page with notification that initial data is needed. The macro then completes the data and clicks submit button. In this case IE.LocationURL indicates this URL:

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

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

but according to the content I get with getElementsbyClassName still reads elements from the initial page:

但根据getElementsbyClassName获取的内容仍然从初始页面读取元素:

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

3 个解决方案

#1

Although QHarr's solution is working in my end, I'm providing with another with no hardcoded delay within the script.

虽然QHarr的解决方案在我的最终工作,但我提供的另一个解决方案在脚本中没有硬编码延迟。

Using IE as your question was:

使用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

Reference to add to the library:

参考添加到库:

1. Microsoft Internet Controls
2. Microsoft HTML Object Library

Using xmlhttp request (It is way faster than IE):

使用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

Reference to add to the library:

参考添加到库:

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

#2

This worked to print out the VAT response table

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

Note:

If on 32-bit remove the PtrSafe.

如果在32位上删除PtrSafe。

Code:

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

Output:

#3

Most of the time you should search if there isn't a REST/SOAP available to achieve that kind of task. Using an Internet Explorer instance for this is a total overkill.

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

Try this simple function, that uses the SOAP service to validate VAT numbers:

试试这个简单的函数,它使用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

And then you can simply validate all your vat numbers:

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

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