il tasto f4 del foglio Excel viene settato per la ricerca di una partita iva sul sistema Vies

'

Option Explicit

'

' il tasto f4, del foglio Excel, viene settato, per la ricerca

' di una partita iva, sul sistema Vies

'

Public mcodicehtml

'

Sub settaTastoF4()

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

End Sub

'

Sub tastof4CercaPartitaIvaVies()

Dim riga, piva, colonna

colonna = "A" ' colonna del foglio dove si trova la partita iva

riga = ActiveCell.Row

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

Call CercaPartitaIvaVies(piva)

End Sub

'

Sub CercaPartitaIvaVies(passapiva)

    Dim i As Long

    Dim IE As Object

    Dim objElement As Object

    Dim objCollection As Object

    Dim HTMLDOC, htmlcodice, htmltesto, stxt

 

    ' Crea Oggetto Internet Explorer

    Set IE = CreateObject("InternetExplorer.Application")

 

    ' internet explorer non visibile, in attesa di risposta

    IE.Visible = False

 

    ' link al sito

    IE.Navigate "http://www1.agenziaentrate.gov.it/servizi/vies/vies.htm?p=&s=IT"

 

    ' Statusbar

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

 

    ' attende che IE venga caricato...

    Do While IE.Busy

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

    Loop

'

' Rircerca dei campi per id :

'

Application.StatusBar = "Attesa invio dati. Attedere."

 

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

 

    i = 0

    While i < objCollection.Length

        If objCollection(i).ID = "vies_piva" Then

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

            ' Set testo di ricerca

            objCollection(i).Value = passapiva

         Else

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

               objCollection(i).ID = "vies_formfcs" Then

              ' objCollection(i).Name = "" Then

 '

               ' tag trovato

              Set objElement = objCollection(i)

 '

        End If

        End If

        i = i + 1

    Wend

   

    objElement.Click    ' click sul bottone di ricerca

   

    ' attende risposta da 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", 10, Now)

    ' IE.Quit

    '

    '

    Set IE = Nothing

    Set objElement = Nothing

    Set objCollection = Nothing

 '

    Application.StatusBar = ""

'

End Sub

'

' nel caso si voglia scrivere su file l'esito della ricerca

'

Function WriteLineToFile(ptesto)

'

Const ForReading = 1, ForWriting = 2

Dim fso, f

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.OpenTextFile("c:\dati-scritti-testfile.txt", ForWriting, True)

f.WriteLine ptesto ' "VBScript is fun!"

f.Close

'

End Function

'