Tred
Tred

Reputation: 3

VBA reads HTML from the old page after clicking submit button

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.

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.

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.

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:

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:

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:

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

Upvotes: 0

Views: 1374

Answers (3)

SIM
SIM

Reputation: 22440

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

Using IE as your question was:

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):

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

Upvotes: 1

drec4s
drec4s

Reputation: 8077

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.

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

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

Upvotes: 0

QHarr
QHarr

Reputation: 84475

This worked to print out the VAT response table

Note:

If on 32-bit remove the 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:

Output

Upvotes: 2

Related Questions