vba Excel verifica una partita iva di un operatore non Vies

'

‘ vba Excel verifica una partita iva di un operatore non Vies

‘ scrive l’esito della ricerca sia in formato Html che testo.

‘

‘

Option Explicit

'

Public Const cartellaarchivio = "C:\archivio-dati\"

Public risposta

'

Sub settaTastoF4CercaPartitaIvaAEchiudi()

Application.OnKey "{F4}", "tastoCercaPartitaIvaAEchiudi"

End Sub

'

Sub tastoCercaPartitaIvaAEchiudi()

Dim riga, piva, contarighe, maxrighe, sriga, contenuto

Dim colonnapartitaiva, colonnarisposta

colonnapartitaiva = "A"

colonnarisposta = "O"

riga = ActiveCell.Row

piva = ActiveSheet.Cells(riga, colonnapartitaiva).Value

Call CercaPartitaIvaAEchiudi(piva)

'

ActiveSheet.Cells(riga, colonnarisposta).Value = risposta

'

'

End Sub

'

Sub CercaPartitaIvaAEchiudi(passapiva)

    Dim i As Long

    Dim IE As Object

    Dim objElement As Object

    Dim objCollection As Object

 '

    Dim HTMLDOC, htmltesto, codicehtml, presente, presente1, presente2

 

   ' Create InternetExplorer Object

    Set IE = CreateObject("InternetExplorer.Application")

 

   ' applicazione non visibile

   IE.Visible = False

 

    ' url

    IE.Navigate "https://telematici.agenziaentrate.gov.it/VerificaPIVA/IVerificaPiva.jsp"

 

    ' messaggio di attesa

    Application.StatusBar = "in attesa di connessione. Please wait..."

 

    ' attende il caricamento della pagina.

    Do While IE.Busy

        Application.Wait DateAdd("s", 1, Now)

    Loop

 

    ' esempio di ricerca per input tags:

    '   1. Text field

    '   <input type="text" class="textfield" name="s" size="24" value="" />

    '

    '   2. Button

    '   <input type="submit" class="button" value="" />

    ' messaggio di attesa

    Application.StatusBar = "Caricamento in corso wait..."

 

    Set objCollection = IE.Document.getElementsByTagName("input")

 

    i = 0

    While i < objCollection.Length

        If objCollection(i).Name = "piva" Then

 

            ' inserisce il valore

            objCollection(i).Value = passapiva

 

        Else

           ' If objCollection(i).Type = "submit" And _

           '   objCollection(i).Name = "" Then

           '

           '   ' "Search" button trovato

           '    Set objElement = objCollection(i)

           '

           ' End If

        End If

        i = i + 1

    Wend

  '  objElement.Click    ' click sul button search

   

    ' attende il caricamento della pagina.

    Do While IE.Busy

        Application.Wait DateAdd("s", 1, Now)

    Loop

 

    ' oggetto IE visibile

    IE.Visible = True

'

    Set HTMLDOC = IE.Document

    htmltesto = HTMLDOC.body.innerText

    codicehtml = HTMLDOC.body.innerhtml

    presente = 0

    While presente = 0

       presente1 = InStr(htmltesto, "PARTITA IVA ATTIVA")

       presente2 = InStr(htmltesto, "PARTITA IVA CESSATA")

       If presente1 > 0 Then

          presente = presente1

          risposta = "trovato"

       End If

       If presente2 > 0 Then

          presente = presente2

          risposta = "cessato"

       End If

       If presente > 0 Then

          Call ScriviDatiToFile(cartellaarchivio & passapiva & ".txt", htmltesto)

          Call ScriviDatiToFile(cartellaarchivio & passapiva & ".html", codicehtml)

       End If

       Application.Wait DateAdd("s", 3, Now)

       Set HTMLDOC = IE.Document

       htmltesto = HTMLDOC.body.innerText

       codicehtml = HTMLDOC.body.innerhtml

       '

 

       '

    Wend

'

    IE.Quit

'

'

    Set IE = Nothing

    Set objElement = Nothing

    Set objCollection = Nothing

 

    Application.StatusBar = ""

'

'

End Sub

'

Sub ScriviDatiToFile(parchivio, ptesto)

'

Const ForReading = 1, ForWriting = 2

Dim fso, f

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.OpenTextFile(parchivio, ForWriting, True)

f.WriteLine ptesto '

f.Close

'

End Sub