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
'
'
'

vbs gestione intervalli data per sql

'
option explicit
'
' vbs - gestire la data attuale, scrive data in formato ansi.
' riceve come input la cartella su cui scrivere i files con le date richieste.
'
dim objArgs, Title
Set objArgs = WScript.Arguments  'Controlla se esistono argomenti passati allo script
if objargs.count=0 then  'altrimenti visualizzo come si usa il programma
 msgbox "Trascinare un file sul programma per visualizzarlo", vbinformation+vbokonly, Title
 wscript.quit
end if
'
dim cartella
'
cartella = wscript.arguments(0)
'
dim dblog, slog, jarchivio
'
dim oggi
dim datasqlcorrente, datarichiesta, datasqlrichiesta

oggi = date
'
datasqlcorrente = fdatasql(oggi)
datarichiesta = fdatarichiesta(oggi)
'
datasqlrichiesta = fdatasql(datarichiesta)
'
dblog = cartella & "db-j-data-corrente.txt"
slog = oggi
call SovraScriviFile(dblog, slog)
'
dblog = cartella & "db-j-data-sql-corrente.txt"
slog = datasqlcorrente
call SovraScriviFile(dblog, slog)
'
dblog = cartella & "db-j-data-sql-richiesta.txt"
slog = datasqlrichiesta
call SovraScriviFile(dblog, slog)
'
'
' =========
'
function fdatarichiesta(pdata)
'
' legge di quanti giorni si vuole variare la data. per data passata inserire il numero in negativo. esempio -15
jarchivio = cartella & "db-j-data-varia-piu-o-meno-giorni.txt"
dim variadigioni

variadigioni = leggituttopulisci(jarchivio)
fdatarichiesta = dateadd("d", variadigioni, pdata)
end function
'
'
'
function fdatasql(pdata)
' genera la data nel formato: anno-mese-giorno. il 31/12/2099 diventa 2099-12-31
dim anno, mese, giorno, sdataj
anno = year(pdata)
sdataj = "00" & month(pdata)
mese = right(sdataj, 2)
sdataj = "00" & day(pdata)
giorno = right(sdataj, 2)
'
fdatasql = anno & "-" & mese & "-" & giorno
'
end function
'
' ============
'
function leggituttopulisci(pfiledaleggere)
'
dim contenutoletto
dim objFSO, objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(pfiledaleggere) = true  Then
    'esistefile = "si"
    Set objFile = objFSO.OpenTextFile(pfiledaleggere, 1)
    contenutoletto = objFile.Readall
    objFile.Close
Else
    'esistefile = "no"
    contenutoletto = "0"
    call SovraScriviFile(pfiledaleggere, contenutoletto)
End If
'
contenutoletto = replace(contenutoletto, vbcrlf, "")
contenutoletto = replace(contenutoletto, vbcr, "")
contenutoletto = replace(contenutoletto, vblf, "")
'
leggituttopulisci = contenutoletto
'
Set objFSO = Nothing
'
end function
' =====
' ========= sovra scrive file ===================
'
Sub SovraScriviFile(pNomeArchivio, pcosascrivere)
dim fso,  rifefile
Set fso=CreateObject("Scripting.FileSystemObject")
Set rifefile = fso.CreateTextFile(pNomeArchivio, TRUE)
rifefile.WriteLine(pcosascrivere)
rifefile.Close
set rifefile = Nothing
End Sub
'
' =======