vbs estrae dal file righe con codici intrastat

‘

‘

option explicit

'

' vbs legge un file di testo

' ed estrare solo le righe contenti un numero lungo otto cifre.

' esempio: ricerca codici Intrastat.

'

dim spazi

spazi = "                                                              "

'

dim nomearchivio

nomearchivio = "C:\filepdfatesto.txt"

'

dim dblog,  slog

dblog = "C:\filepdfatesto-filtrato-a.txt"

call SovraScriviFile(dblog, "")

'

'

call leggielenco(nomearchivio)

'

call ScriviFileJollyAppend(dblog, "F")

'

' ====

sub leggielenco(filedaleggere)

 

dim objFSO, objFile, strLine, trovato,  trovato2, chiave

dim primaparte, secondaparte, srisultato

 

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.OpenTextFile(filedaleggere, 1)

'

Do While objFile.AtEndOfStream = False

   strLine = objFile.ReadLine

   if len(trim(strLine)) > 0 then

      trovato =  TrovaValore(strLine,"\s\d{8}\s")

      if len(trovato) > 0 then

         slog = strLine

         call ScriviFileJollyAppend(dblog, slog)

      end if

   end if

'

'

Loop

'

'

end sub

'

' ====================================

'

Sub ScriviFileJollyAppend(pNomeArchivio, pcosascrivere)

dim fso,  rifefile

Set fso=CreateObject("Scripting.FileSystemObject")

If (fso.FileExists(pNomeArchivio)) Then

      'msg = filespec & " esiste."

       Set rifefile = fso.OpenTextFile(pNomeArchivio, 8)

Else

      'msg = filespec & " Non esiste."

       Set rifefile = fso.CreateTextFile(pNomeArchivio, TRUE)

End If

rifefile.WriteLine(pcosascrivere)

rifefile.Close

set rifefile = Nothing

End Sub

'

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

'

' =================

'

Function TrovaValore(strVal, comecercare) 'As String

TrovaValore = ""

Dim sParts, sPart, rPart 'As Object

Set rPart = CreateObject("VBScript.RegExp")

rPart.Global = True

rPart.IgnoreCase = True

rPart.pattern = comecercare '

' test di ricerca

if rPart.Test(strVal) then

   Set sParts = rPart.Execute(strVal)

   ' restituisce il primo risultato

   For Each sPart In sParts

      TrovaValore = sParts(0)

      Exit For

   Next 'sPart

   else

   TrovaValore = ""

   end if

Set sParts = Nothing

End Function

'

' =================

'