VBA automate IE actions

Rasmussen

New Member
Joined
Jun 10, 2019
Messages
24
Hello,

I found this VBA from automatetheweb and I found it very useful to my daily work.

I want to automate the search we daily do with VAT numbers from the EU vies validation page.

So the VBA is suppose to go to the website http://ec.europa.eu/taxation_customs/vies/, then insert A2 in country code and B2 in the text field, then hit submit to get result.

I then need it to show the result in C2, wether it's valid or not.

My problem is, that when I use debug (F8) function in the VBA, there is no problems, but when I then try to run the macro from developer field, it gets stuck at the result page, it doesnt list the result in C2?

The code is following.

Code:
'start a new subroutine called SearchBotSub SearchBot()
 
    'dimension (declare or set aside memory for) our variables
    Dim objIE As InternetExplorer 'special object variable representing the IE browser
    Dim aEle As HTMLLinkElement 'special object variable for an  (link) element
    Dim y As Integer 'integer variable we'll use as a counter
    Dim result As String 'string variable that will hold our result link
 
    'initiating a new instance of Internet Explorer and asigning it to objIE
    Set objIE = New InternetExplorer
 
    'make IE browser visible (False would allow IE to run in the background)
    objIE.Visible = True
 
    'navigate IE to this web page (a pretty neat search engine really)
    objIE.navigate "http://ec.europa.eu/taxation_customs/vies/"
 
    'wait here a few seconds while the browser is busy
    Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
 
    'in the search box put cell "A2" value, the word "in" and cell "C1" value
    objIE.document.getElementById("countryCombobox").Value = _
      Sheets("Sheet1").Range("A2").Value
      objIE.document.getElementById("number").Value = _
      Sheets("Sheet1").Range("B2").Value
 
    'click the 'go' button
    objIE.document.getElementById("submit").Click
 
    'wait again for the browser
    Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
 
    'the first search result will go in row 2
    y = 2
 
    'for each  element in the collection of objects with class of 'result__a'...
    For Each Text In objIE.document.getElementsByClassName("labelLeft")
 
        '...get the text within the element and print it to the sheet in col D
        Sheets("Sheet1").Range("D" & y).Value = Text.innerText
        Debug.Print Text.innerText
 
        'is it a yellowpages link?
        If InStr(result, "Nej, momsnummeret er ugyldigt") > 0 Or InStr(result, "Nej") > 0 Then
            'make the result red
            Sheets("Sheet1").Range("C" & y).Interior.ColorIndex = 3
            'place a 1 to the left
            Sheets("Sheet1").Range("B" & y).Value = 1
        End If
 
        'increment our row counter, so the next result goes below
        y = y + 1
 
    'repeat times the # of ele's we have in the collection
    Next
 
    'close the browser
    objIE.Quit
 
'exit our SearchBot subroutine
End Sub

Anyone who can help me out? Thanks.
 
Last edited by a moderator:
OK, here's a better approach, don't use webscraping when the site offers a webservice. This code will return true when valid, false when invalid, if the input is invalid, the error description from the server is returned. If there is an unhandled error, a generic Excel error is listed.

For your DK example above, a TIMEOUT error is returned (as from the website).
Code:
Public Function IsVatNumberValid(ByVal countryCode As String, ByVal vatNumber As String) As Variant

    Static req As Object
    If req Is Nothing Then Set req = CreateObject("MSXML2.XMLHTTP")
    
    On Error GoTo handler
    
    With req
        .Open "POST", "http://ec.europa.eu/taxation_customs/vies/services/checkVatService", False
        .send "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""no""?><SOAP-ENV:Envelope xmlns:SOAP-ENV=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:tns1=""urn:ec.europa.eu:taxud:vies:services:checkVat:types"" xmlns:soapenc=""http://schemas.xmlsoap.org/soap/encoding/"" xmlns:impl=""urn:ec.europa.eu:taxud:vies:services:checkVat"" xmlns:apachesoap=""http://xml.apache.org/xml-soap"" xmlns:wsdl=""http://schemas.xmlsoap.org/wsdl/"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:wsdlsoap=""http://schemas.xmlsoap.org/wsdl/soap/"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" ><SOAP-ENV:Body><tns1:checkVat xmlns:tns1=""urn:ec.europa.eu:taxud:vies:services:checkVat:types""><tns1:countryCode>" & countryCode & "</tns1:countryCode><tns1:vatNumber>" & vatNumber & "</tns1:vatNumber></tns1:checkVat></SOAP-ENV:Body></SOAP-ENV:Envelope>"
        
        
        'There's a server error or an error with the input
        If InStr(.responsetext, "faultstring") > 0 Then
            IsVatNumberValid = Split(Split(.responsetext, "faultstring>")(1), "<")(0)
            Exit Function
        End If
        
        'There are no validation errors, read whether it is valid
        If InStr(.responsetext, "valid") > 0 Then
            IsVatNumberValid = Split(Split(.responsetext, "<valid>")(1), "<")(0)
            Exit Function
        End If
        
    End With
    
'If we've got this far there's something else wrong or an error has been raised
handler:
    IsVatNumberValid = CVErr(18)
    
End Function
 
Upvote 0

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
OK, here's a better approach, don't use webscraping when the site offers a webservice. This code will return true when valid, false when invalid, if the input is invalid, the error description from the server is returned. If there is an unhandled error, a generic Excel error is listed.

For your DK example above, a TIMEOUT error is returned (as from the website).
Code:
Public Function IsVatNumberValid(ByVal countryCode As String, ByVal vatNumber As String) As Variant

    Static req As Object
    If req Is Nothing Then Set req = CreateObject("MSXML2.XMLHTTP")
    
    On Error GoTo handler
    
    With req
        .Open "POST", "http://ec.europa.eu/taxation_customs/vies/services/checkVatService", False
        .send "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""no""?><SOAP-ENV:Envelope xmlns:SOAP-ENV=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:tns1=""urn:ec.europa.eu:taxud:vies:services:checkVat:types"" xmlns:soapenc=""http://schemas.xmlsoap.org/soap/encoding/"" xmlns:impl=""urn:ec.europa.eu:taxud:vies:services:checkVat"" xmlns:apachesoap=""http://xml.apache.org/xml-soap"" xmlns:wsdl=""http://schemas.xmlsoap.org/wsdl/"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:wsdlsoap=""http://schemas.xmlsoap.org/wsdl/soap/"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" ><SOAP-ENV:Body><tns1:checkVat xmlns:tns1=""urn:ec.europa.eu:taxud:vies:services:checkVat:types""><tns1:countryCode>" & countryCode & "</tns1:countryCode><tns1:vatNumber>" & vatNumber & "</tns1:vatNumber></tns1:checkVat></SOAP-ENV:Body></SOAP-ENV:Envelope>"
        
        
        'There's a server error or an error with the input
        If InStr(.responsetext, "faultstring") > 0 Then
            IsVatNumberValid = Split(Split(.responsetext, "faultstring>")(1), "<")(0)
            Exit Function
        End If
        
        'There are no validation errors, read whether it is valid
        If InStr(.responsetext, "valid") > 0 Then
            IsVatNumberValid = Split(Split(.responsetext, "<valid>")(1), "<")(0)
            Exit Function
        End If
        
    End With
    
'If we've got this far there's something else wrong or an error has been raised
handler:
    IsVatNumberValid = CVErr(18)
    
End Function

Works great, thank you.

Is it possible to change the True and False result text to whatever text I want?
 
Upvote 0
Yes, like this:
Code:
Public Function IsVatNumberValid(ByVal countryCode As String, ByVal vatNumber As String) As Variant

    Static req As Object
    If req Is Nothing Then Set req = CreateObject("MSXML2.XMLHTTP")
    
    On Error GoTo handler
    
    With req
        .Open "POST", "http://ec.europa.eu/taxation_customs/vies/services/checkVatService", False
        .send "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""no""?><SOAP-ENV:Envelope xmlns:SOAP-ENV=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:tns1=""urn:ec.europa.eu:taxud:vies:services:checkVat:types"" xmlns:soapenc=""http://schemas.xmlsoap.org/soap/encoding/"" xmlns:impl=""urn:ec.europa.eu:taxud:vies:services:checkVat"" xmlns:apachesoap=""http://xml.apache.org/xml-soap"" xmlns:wsdl=""http://schemas.xmlsoap.org/wsdl/"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:wsdlsoap=""http://schemas.xmlsoap.org/wsdl/soap/"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" ><SOAP-ENV:Body><tns1:checkVat xmlns:tns1=""urn:ec.europa.eu:taxud:vies:services:checkVat:types""><tns1:countryCode>" & countryCode & "</tns1:countryCode><tns1:vatNumber>" & vatNumber & "</tns1:vatNumber></tns1:checkVat></SOAP-ENV:Body></SOAP-ENV:Envelope>"
        
        
        'There's a server error or an error with the input
        If InStr(.responsetext, "faultstring") > 0 Then
            IsVatNumberValid = Split(Split(.responsetext, "faultstring>")(1), "<")(0)
            Exit Function
        End If
        
        'There are no validation errors, read whether it is valid
        If InStr(.responsetext, "valid") > 0 Then
            If Split(Split(.responsetext, "<valid>")(1), "<")(0) = "true" Then
                IsVatNumberValid = "Yes, it's a valid code"
            Else
                IsVatNumberValid = "No, it's not a valid code"
            End If
            Exit Function
        End If
        
    End With
    
'If we've got this far there's something else wrong or an error has been raised
handler:
    IsVatNumberValid = CVErr(18)
    
End Function
 
Upvote 0
Yes, like this:
Code:
Public Function IsVatNumberValid(ByVal countryCode As String, ByVal vatNumber As String) As Variant

    Static req As Object
    If req Is Nothing Then Set req = CreateObject("MSXML2.XMLHTTP")
    
    On Error GoTo handler
    
    With req
        .Open "POST", "http://ec.europa.eu/taxation_customs/vies/services/checkVatService", False
        .send "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""no""?><SOAP-ENV:Envelope xmlns:SOAP-ENV=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:tns1=""urn:ec.europa.eu:taxud:vies:services:checkVat:types"" xmlns:soapenc=""http://schemas.xmlsoap.org/soap/encoding/"" xmlns:impl=""urn:ec.europa.eu:taxud:vies:services:checkVat"" xmlns:apachesoap=""http://xml.apache.org/xml-soap"" xmlns:wsdl=""http://schemas.xmlsoap.org/wsdl/"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:wsdlsoap=""http://schemas.xmlsoap.org/wsdl/soap/"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" ><SOAP-ENV:Body><tns1:checkVat xmlns:tns1=""urn:ec.europa.eu:taxud:vies:services:checkVat:types""><tns1:countryCode>" & countryCode & "</tns1:countryCode><tns1:vatNumber>" & vatNumber & "</tns1:vatNumber></tns1:checkVat></SOAP-ENV:Body></SOAP-ENV:Envelope>"
        
        
        'There's a server error or an error with the input
        If InStr(.responsetext, "faultstring") > 0 Then
            IsVatNumberValid = Split(Split(.responsetext, "faultstring>")(1), "<")(0)
            Exit Function
        End If
        
        'There are no validation errors, read whether it is valid
        If InStr(.responsetext, "valid") > 0 Then
            If Split(Split(.responsetext, "<valid>")(1), "<")(0) = "true" Then
                IsVatNumberValid = "Yes, it's a valid code"
            Else
                IsVatNumberValid = "No, it's not a valid code"
            End If
            Exit Function
        End If
        
    End With
    
'If we've got this far there's something else wrong or an error has been raised
handler:
    IsVatNumberValid = CVErr(18)
    
End Function

This works perfectly, thank you very much.

Do you know if it's possible to add a print and save to PDF with Public function?
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top