giovedì 17 ottobre 2019

vba - ricerca partita iva se presente nel vies della commissione europea

'
Option Explicit
'
' vba -Excel - ricerca partita iva se presente nel vies della commissione europea
' legge le partite iva da un foglio excel.
' scrive se la parita iva è presente nel vies.
' la macro è settata per la ricerca della partite iva italiane.
'
Dim esitovies
Dim mcodicehtml
Public Const partitaivadelrichiedente = "00000000000" ' partita iva del richiedente
'
Sub VatNumberGiriAblocchi()
Dim quanterighe, contarighe, foglio, contenuto, colonnapartitaiva, stxt, contali, sverifica
Dim colonnaesito
Dim nblocco
Set foglio = Sheets(ActiveSheet.Name)
'
quanterighe = Range(foglio.UsedRange.Cells(foglio.UsedRange.Rows.Count, 1).Address).Row
colonnapartitaiva = "A"   ' colonna in cui è presente la partita iva del cliente
colonnaesito = "K"        ' colonna dove scrivere l'esito della ricerca.
'
contali = 1
nblocco = 10 ' 150    ' numero di partite iva da verificare.
'contarighe = 2
contarighe = ActiveCell.Row      ' inizia il controllo dalla cella attiva.
'
While contarighe <= quanterighe
      contenuto = Trim(foglio.Cells(contarighe, colonnapartitaiva).Value)
      sverifica = Trim(foglio.Cells(contarighe, colonnaesito).Value)
      If Len(contenuto) = 11 And Len(sverifica) = 0 Then
         foglio.Cells(contarighe, colonnapartitaiva).Activate
         '
         Call CercaPartitaVatNumber(contenuto)
'
         foglio.Cells(contarighe, colonnaesito).Value = esitovies
         '
        contali = contali + 1
         '
         Application.Wait DateAdd("s", 15, Now) ' attendi 15 secondi
         If contali >= nblocco Then
            Exit Sub                    ' esce dalla macro al raggiungimento del numero prefissato di ricerche.
         End If
      End If
      contarighe = contarighe + 1       ' incrementa il numnero delle righe
Wend
'
End Sub
'
'
'
Sub CercaPartitaVatNumber(passapiva)
    Dim i As Long
    Dim IE As Object
    Dim objElement As Object
    Dim objCollection As Object
    Dim HTMLDOC, htmlcodice, htmltesto, stxt
 
    'crea oggetto InternetExplorer
    Set IE = CreateObject("InternetExplorer.Application")
 
    '
    IE.Visible = False
 
    ' url della pagina in cui inserire i dati per la ricerca
    IE.Navigate "http://ec.europa.eu/taxation_customs/vies/vatRequest.html"
 
    ' Statusbar
    Application.StatusBar = "in attesa di connessione. Attendere..."
 
    ' attendi un secondo fino alla lettura completa di IE.
    Do While IE.Busy
        Application.Wait DateAdd("s", 1, Now)
    Loop
 '
 '
    ' cerca 2 tags input:
    '   1. Text field
    '   <input type="text" class="textfield" name="s" size="24" value="" />
    '
    '   2. Button
    '   <input type="submit" class="button" value="" />
   
    Application.StatusBar = "cerca casella di input dei valori. Attendere..."
 
    Set objCollection = IE.document.getElementsByTagName("input")
 
    i = 0
    While i < objCollection.Length
        If objCollection(i).ID = "requesterNumber" Then        ' partita iva del richiedente
           objCollection(i).Value = partitaivadelrichiedente
        End If
 '
      
        If objCollection(i).ID = "number" Then
        'If objCollection(i).Name = "piva" Then
            ' inserisce la partita iva da verificare.
            objCollection(i).Value = passapiva
 
        Else
            If objCollection(i).Type = "submit" And _
                objCollection(i).Value = "Verificare" Then
              ' objCollection(i).ID = "vies_formfcs" Then
              ' objCollection(i).Name = "" Then
 '
  '              ' memorizza il pulsante cerca
              Set objElement = objCollection(i)
 '
        End If
        End If
        i = i + 1
    Wend
   
    '
    Dim e, e2
    Set e = IE.document.getElementById("countryCombobox")
    e.SelectedIndex = 17        ' stato IT = italia
    Set e2 = IE.document.getElementById("requesterCountryCombobox")
    e2.SelectedIndex = 18       ' stato IT = italia
    '
    objElement.Click    ' click bottone avvio ricerca
    '
    ' attende aggiornamento di IE.
    Do While IE.Busy
        Application.Wait DateAdd("s", 1, Now)
    Loop
 
    ' IE visibile
    IE.Visible = True
 '
    Set HTMLDOC = IE.document
    'MsgBox HTMLDOC.body.innerText
    htmlcodice = HTMLDOC.body.innerhtml
    htmltesto = HTMLDOC.body.innerText
    mcodicehtml = HTMLDOC.body.innerhtml
    'stxt = WriteLineToFile(htmlcodice & vbCrLf & htmltesto)
    'stxt = WriteLineToFile(trovaesito(htmlcodice))
    Application.Wait DateAdd("s", 5, Now)
    IE.Quit
 
 '  numero di partita IVA verifica se trovato
    stxt = trovaesitovies(mcodicehtml)
 
 
    ' chiude
    Set IE = Nothing
    Set objElement = Nothing
    Set objCollection = Nothing
'
    Application.StatusBar = ""
'
End Sub
'
'
'
Function trovaesitovies(ptesto)
'<p class="vies_ok">CODICE IVA VALIDO</p>
Dim objre
Set objre = CreateObject("vbscript.regexp")
With objre
    .Pattern = "partita IVA valida"
    .IgnoreCase = True
    .Global = False
End With
' Test se partita iva trovata.
If objre.Test(ptesto) Then
    trovaesitovies = "vies_ok"
Else
    trovaesitovies = "non_trovato"
End If
'
esitovies = trovaesitovies
'
Set objre = Nothing
'
End Function
'
'
'

Nessun commento:

Posta un commento