gestione contatore numero report - vbs

'

' traferito

Option Explicit

'

'

Dim objA

Set objA = Wscript.Arguments

if objA.count <> 3 Then

Wscript.Echo "Gestione Contatore - serve la directory File!"

Wscript.Quit

End If

'

dim dbcartellaprocedura, archivioinput, archiviooutput, testoinput, testooutput

dbcartellaprocedura = objA(0)

archivioinput = dbcartellaprocedura & objA(1)

archiviooutput = dbcartellaprocedura & objA(2)

'

dim contenutoletto

dim dbcontatore, numeroreport

'

dbcontatore = dbcartellaprocedura & "db-numero-report.txt"

'

'

' - legge o crea il numeratore dei report

call LeggioCreaFileParametri(dbcontatore, 1)

'

if isnumeric(contenutoletto) = true then

numeroreport = contenutoletto + 1

else

numeroreport = 1

end if

'

call SovraScriviFile(dbcontatore, numeroreport)

'

testoinput = leggiparametri(archivioinput)

testooutput = testoinput & " - report numero: " & numeroreport



call SovraScriviFile(archiviooutput, testooutput)

'

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

' === 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 leggiparametri(sFilePathAndName)

dim sFileContents, oFS, oTextStream, esito

Set oFS = CreateObject("Scripting.FileSystemObject")

If oFS.FileExists(sFilePathAndName) = True Then

Set oTextStream = oFS.OpenTextFile(sFilePathAndName,1)

sFileContents = trim(oTextStream.ReadAll)

oTextStream.Close

Set oTextStream = nothing

else

'esito = esito + 1

End if

Set oFS = nothing

'

leggiparametri = sFileContents

'

'

end function

'

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

'

Sub LeggioCreaFileParametri(sFileName, valoredefault)

'

dim objFSO, objFile, strLine

Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists(sFilename) Then

'esistefile = "si"

Set objFile = objFSO.OpenTextFile(sFileName, 1)

'contenutoletto = objFile.Readall

contenutoletto = objFile.ReadLine

Else

'esistefile = "no"

contenutoletto = valoredefault

Set objFile = objFSO.CreateTextFile(sFileName, TRUE)

objFile.WriteLine(valoredefault)

End If

'

Set objFile = Nothing

Set objFSO = Nothing

'

End sub

'

' ========

'

prg esegui programma dopo n giorni - vbs

' trasferito

option explicit

'

dim contenutoletto

'

dim cartelladilavoro, dblog, slog

cartelladilavoro = "C:\azioniprogrammate\modelli\esegui-dopo-n-giorni\"

'

dblog = cartelladilavoro & "db-alla-data.txt"

'

dim fromDate, toDate, differenza

'

call leggitutto(dblog)

toDate = contenutoletto

fromDate = date

differenza = DateDiff("d", toDate, fromDate) ' giorni

'

dim ogniquantigiorni, dbgiorni

dbgiorni = cartelladilavoro & "db-ogni-quanti-giorni.txt"

call leggitutto(dbgiorni)

ogniquantigiorni = clng(contenutoletto)

'

if isnumeric(ogniquantigiorni) = true then

if differenza > ogniquantigiorni then

slog = date

dblog = cartelladilavoro & "db-alla-data.txt"

call SovraScriviFile(dblog, slog)

call eseguiprogramma

end if

end if

'

' =========

'

sub eseguiprogramma()

'

Dim objShell, attesa, azione, programma

Set objShell = Wscript.CreateObject("WScript.Shell")

' ====

dim dbprogramma

dbprogramma = cartelladilavoro & "db-programma-da-eseguire.txt"

call leggitutto(dbprogramma)

'

programma = contenutoletto

azione = programma

attesa = objShell.Run(azione, 1, true)

'



end sub

'

' =========

'

sub leggitutto(pfiledaleggere)

'

dim objFSO, objFile

Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists(pfiledaleggere) Then

'esistefile = "si"

Set objFile = objFSO.OpenTextFile(pfiledaleggere, 1)

contenutoletto = objFile.Readall

contenutoletto = replace(contenutoletto, vbcrlf, "")

contenutoletto = replace(contenutoletto, vbcr, "")

contenutoletto = replace(contenutoletto, vblf, "")

objFile.Close

Else

'esistefile = "no"

contenutoletto = ""

End If

Set objFSO = 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

'

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

'

Crea dizionario linee commerciali - File carattestiche Prodotto

Attribute VB_Name = "m_linee_commerciali"

'

Option Explicit

'



'

' trasferito

'

Sub CreaDizionarioLineeCommerciali()

' suddivide il file importato CARATTERISTAPRODOTTO (ECP)

' filtrando per sigla del produttore e marca,

' seleziona solo le righe con il codice: "LINEA COMMERCIALE"

' e crea un foglio per ognuna di esse.

'

Dim dizionario

Set dizionario = CreateObject("Scripting.Dictionary")

'

Dim quanterighe, contarighe, foglio, contenuto

Dim sigla, marca, identificativo, descrlinea

Dim sigladacercare, marcadacercare, identificativodacercare, contale

sigladacercare = "?sigla?"

marcadacercare = "?marca?"

identificativodacercare = "?id?"

Set foglio = Sheets("xlsCaratteristicheProdotto")

'

quanterighe = Range(foglio.UsedRange.Cells(foglio.UsedRange.Rows.Count, 1).Address).Row

'

contale = 0

contarighe = 2

While contarighe <= quanterighe

sigla = Trim(foglio.Cells(contarighe, "A").Value)

marca = Trim(foglio.Cells(contarighe, "B").Value)

identificativo = Trim(foglio.Cells(contarighe, "E").Value)

descrlinea = Trim(foglio.Cells(contarighe, "F").Value)

'

If sigla = sigladacercare Then

If marca = marcadacercare Then

If identificativo = identificativodacercare Then

If dizionario.Exists(descrlinea) = True Then

' msgbox "Key esiste!"

contenuto = dizionario.Item(descrlinea)

contenuto = contenuto & " " & contarighe ' memorizza la riga

dizionario.Item(descrlinea) = contenuto

Else

' msgbox "chiave non esiste!"

contenuto = contarighe

dizionario.Add descrlinea, contenuto

End If

End If



End If

End If

'

contarighe = contarighe + 1

Wend

'

Dim elenco, contatore, slinea, sriga, righe, nrvalori, srighe, rigacp, scriviriga

sriga = 1

elenco = dizionario.keys

For contatore = 0 To dizionario.Count - 1

slinea = elenco(contatore)

sriga = sriga + 1

Sheets("LineeCommerciali").Cells(sriga, "A").Value = slinea

Sheets("LineeCommerciali").Cells(sriga, "B").Value = dizionario.Item(slinea)

'

righe = Split(dizionario.Item(slinea), " ")

nrvalori = UBound(righe)

Sheets("Foglio3").Cells(sriga, "c").Value = UBound(righe)

'

scriviriga = 5

Sheets.Add

Columns("A:G").Select

Selection.NumberFormat = "@"

ActiveSheet.Range("A2").Value = "Marchio: "

ActiveSheet.Range("B2").Value = "?marchio?"

ActiveSheet.Range("A3").Value = "linea: "

ActiveSheet.Range("B3").Value = slinea

ActiveSheet.Range("a4").Value = "articolo"

ActiveSheet.Range("B4").Value = "descrizione"

For Each srighe In righe

rigacp = srighe

ActiveSheet.Cells(scriviriga, "A").Value = foglio.Cells(srighe, "C").Value ' articolo

ActiveSheet.Cells(scriviriga, "B").Value = foglio.Cells(srighe, "K").Value ' descrizione

scriviriga = scriviriga + 1

Next

'

Next

'

Set dizionario = Nothing

'

End Sub

'

p01 programma verifica cambio sigle - vbs

'

' trasferito

'

Option Explicit

'

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

'

dim cartelladilavoro, dbcartelladilavoro

cartelladilavoro = "C:\articoli-cambio-sigle\"

dbcartelladilavoro = cartelladilavoro & "db-cartella-di-lavoro.txt"

call SovraScriviFile(dbcartelladilavoro, cartelladilavoro)

'

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

'

dim dblog, slog

'

dim contenutoletto

'

dim stringasql, jstringasql, dbstringasql

dbstringasql = cartelladilavoro & "db-stringa-sql-modello.txt"

call leggitutto(dbstringasql)

jstringasql = contenutoletto

'

dim archiviodaleggere

archiviodaleggere = cartelladilavoro & "db-01-elenco-sigle.txt"

call leggielenco(archiviodaleggere)

'

' ====

'

sub leggielenco(filedaleggere)

dim objFSO, objFile, strLine

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.OpenTextFile(filedaleggere, 1)

'

Do While objFile.AtEndOfStream = False

strLine = trim(objFile.ReadLine)

strLine = replace(strLine, vbcrlf, "")

strLine = replace(strLine, vbcr, "")

strLine = replace(strLine, vblf, "")

if len(strline) > 0 then

stringasql = replace(jstringasql, "<#>sigla<#>", strLine)

dblog = cartelladilavoro & "db-stringa-sql.txt"

slog = stringasql

call SovraScriviFile(dblog, slog)

'call chiamaprogramma("prg-estrai-dati-sql.vbs", dbcartelladilavoro)

call chiamaprogramma("p02-prg-estrai-dati-sql-dizionario.vbs", cartelladilavoro)

'

dblog = cartelladilavoro & "db-sigla-in-controllo.txt"

slog = strLine

call SovraScriviFile(dblog, slog)

'

call determinatrovati

end if

Loop

'

objFile.Close

Set objFSO = Nothing

Set objFile = Nothing

'

end sub

'

' ====

'

sub determinatrovati()

dim quantitrovati, dbtrovati

dbtrovati = cartelladilavoro & "db-record-estratti.txt"

call leggitutto(dbtrovati)

quantitrovati = trim(contenutoletto)

if isnumeric(quantitrovati) = true then

if cint(quantitrovati) > 0 then

call chiamaprogramma("p03-programma-invia-messaggii-email-utenti.vbs", cartelladilavoro)

else

slog = "niente di nuovo: " & date & " : " & time

call SovraScriviFile(cartelladilavoro & "db-niente-dinuovo.txt", slog)

end if

end if

'

end sub

'

' ====

'

sub chiamaprogramma(nomeprogramma, parametro)

'

Dim objShell, attesa, azione, programma

Set objShell = Wscript.CreateObject("WScript.Shell")

if len(trim(parametro)) > 0 then

programma = cartelladilavoro & nomeprogramma & " " & parametro

else

programma = cartelladilavoro & nomeprogramma

end if

'

azione = ""

azione = azione & programma

azione = azione & " "

'

attesa = objShell.Run(azione, 1, true)

'

end sub

'

' =========

'

sub leggitutto(pfiledaleggere)

'

dim objFSO, objFile

Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists(pfiledaleggere) Then

'esistefile = "si"

Set objFile = objFSO.OpenTextFile(pfiledaleggere, 1)

contenutoletto = objFile.Readall

contenutoletto = replace(contenutoletto, vbcrlf, "")

contenutoletto = replace(contenutoletto, vbcr, "")

contenutoletto = replace(contenutoletto, vblf, "")

objFile.Close

Else

'esistefile = "no"

contenutoletto = ""

End If

Set objFSO = 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

'

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

'

leggi gestione parametri - vbs

'

' gestione di un filme parametri

' ricerca tramite espressione regolare.

' il file parametri ha la struttura di un file xml.

'

option explicit

'

dim strHTML, archivioparametri, jparametri

archivioparametri= "C:\db-parametri.txt"

call leggifileparametri(archivioparametri)

'

jparametri = lavoraparametri(strHTML, "anno", "trova", "")

jparametri = lavoraparametri(strHTML, "anno", "aggiorna", "1999")

jparametri = lavoraparametri(strHTML, "anno", "trova", "1900") ' nel caso non esista

jparametri = lavoraparametri(strHTML, time, "trova", "orario attuale")

'

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

'

function lavoraparametri(sTxt, pnomecampo, pazione, pvaloredefault)

dim oRegex, criterio, retval, agg, nuovovalore

set oRegex = CreateObject("vbscript.regexp")

oRegex.Global = 1

oRegex.Multiline = 1

oRegex.IgnoreCase = 1

'

retval = ""

criterio = "<" & pnomecampo & ">((?:.|\n|\r)*?)</" & pnomecampo & ">"

nuovovalore = "<" & pnomecampo & ">" & pvaloredefault & "</" & pnomecampo & ">"

'

oRegex.Pattern = criterio

If oRegex.Test(sTxt) = true Then

if pazione = "trova" then

retval = oRegex.Execute(sTxt).item(0).SubMatches.item(0)

lavoraparametri = retval

end if

if pazione = "aggiorna" then

agg = oRegex.Replace(strHTML, nuovovalore)

call SovraScriviFile(archivioparametri, agg)

call leggifileparametri(archivioparametri)

end if

else

agg = strHTML & nuovovalore

call SovraScriviFile(archivioparametri, agg)

call leggifileparametri(archivioparametri)

end if

'

'

end function

'

' =========

'

sub leggifileparametri(parchivio)

dim filesys, readfile, jtxt

set filesys = CreateObject ("Scripting.FileSystemObject")



If (filesys.FileExists(parchivio)) Then

'msg = filespec & " esiste."

set readfile = filesys.OpenTextFile(parchivio, 1, false)

strHTML = readfile.ReadAll

Else

'msg = filespec & " Non esiste."

Set readfile = filesys.CreateTextFile(pArchivio, TRUE)

jtxt = "<vuoto>mancano paramenti</vuoto>"

readfile.WriteLine(jtxt)

End If

'

readfile.close

'

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

'

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

'

allinea archivi prima nota legge archivio - vbs

'

option explicit

'

dim cartellabase, cartelladascansionare, a

cartellabase = "C:\azioniprogrammate\archivio_digitale_verifica_esistenza_fatture\"

cartelladascansionare = "C:\ARCHIVIO_DIGITALE_2015\"

'

dim dblog, slog

dblog = cartellabase & "test-report.txt"

'call SovraScriviFile(dblog, " ")

'

dim ArrayOfTerms(), contadati

contadati = 0

'

a = ShowFolderList(cartelladascansionare, "pdf")

'

call ordina

'

' ===

'

Function ShowFolderList(folderspec, ptipo)

Dim fso, f, f1, s, sf, sfiles

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFolder(folderspec)

Set sf = f.SubFolders

For Each f1 in sf

For Each sfiles in fso.GetFolder(f1.Path).Files

If lcase(fso.GetExtensionName(sfiles.Path)) = lcase(ptipo) then

'slog = sfiles.Path

' call ScriviFileJollyAppend(dblog, slog)

'

's = trim(RicercaRisultato(sfiles.Path, "^\d{4}_"))

s = trim(RicercaRisultato(sfiles.Name, "^\d{4}_"))

if len(s) > 0 then

slog = s & vbcrlf & sfiles.Name ' sfiles.Path

'call ScriviFileJollyAppend(dblog, slog)

'add lines

contadati = contadati + 1

redim preserve ArrayOfTerms(contadati)



ArrayOfTerms(contadati) = sfiles.Name

end if

'

End If

Next

Next

'

'

End Function

'

' ===

'

sub ordina()

dim a, j, temp

for a = UBound(ArrayOfTerms) - 1 To 0 Step -1

for j= 0 to a

if ArrayOfTerms(j)>ArrayOfTerms(j+1) then

temp=ArrayOfTerms(j+1)

ArrayOfTerms(j+1)=ArrayOfTerms(j)

ArrayOfTerms(j)=temp

end if

next

next

'

dblog = cartellabase & "db-fatture-esistenti.txt"

call SovraScriviFile(dblog, " ")

dim nrft

'

'

for a = 1 to UBound(ArrayOfTerms)

slog = ArrayOfTerms(a)

nrft = left(slog, 4)

slog = nrft

call ScriviFileJollyAppend(dblog, slog)

next

'

end sub

'

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

'

Function RicercaRisultato(strVal, comecercare) 'As String

Dim sParts, sPart, rPart 'As Object

Set rPart = CreateObject("VBScript.RegExp")

rPart.Global = True

rPart.IgnoreCase = True

rPart.pattern = comecercare '

'get the results

Set sParts = rPart.Execute(strVal)

'get the first match

For Each sPart In sParts

RicercaRisultato = sParts(0)

Exit For

Next 'sPart

Set sParts = 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

'

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

'

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

'

' =========

'

sistema protocollo fatture acquisto - vbs

'

' vbs - trova il numero di protocollo delle fatture d'acquisto.

' scansiona cartella archivio digitale delle fatture di acquisto.

' le fatture sono i file pdf inviati dai fornitori, il nome del file è quello attribuito da fornitore.

' tramite una espressione regolare trova il numero della fattura di acquisto presente nel nome del file,

' sempre che il fornitore vi inserisca questa informazione.

' il criterio di ricerca è archiviato in un file con il nome della cartella, la manca presenza

' di questo file evita che il programma effettui la ricerca.

' con il numero di fattura si effettua una ricerca nella contabilità aziendale per trovare il numero

' con cui è stato protocollato il documento.

' il conto fornitore è stato trovato da un precedente programma, che convertendo il file pdf

' in testo, ricerca la partita iva del fornitore nella anagrafica aziendale.

'

option explicit

'

dim dbcartella, dbannosql, dbpercorsobase, dbstringasql, dbcartelladascansionare

dim dbjollylog, slog, archiviocontofornitore, esito, a, contofornitore

dim annosql, percorsobase, stringasqlbase, tcriterio, criterioricerca

dim nomefornitore, cartellainlavoro, nomefileinricerca, dbcartellaricerca

Dim filenellacartella, tchiave, tchiavi, risultato, tquantek

Set filenellacartella = CreateObject("Scripting.Dictionary")

filenellacartella.CompareMode = vbTextCompare

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

dbcartella = "C:\sistema-protocollo\"

dbcartellaricerca = "C:\sistema-protocollo\ricerca\"

dbpercorsobase = dbcartella & "db-percorso-base.txt"

dbannosql = dbcartella & "db-anno-sql.txt"

dbstringasql = dbcartella & "db-stringa-sql.txt"

dbcartelladascansionare = dbcartella & "db-cartelle-da-scansionare.txt"

archiviocontofornitore = "fornitore-conto-anagrafica.txt"

'

dbjollylog = "C:\sistema-protocollo\log-jolly.txt"

' ---

esito = 0

'

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

' carica anno

annosql = leggiparametri(dbannosql)

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

' leggi path base

percorsobase = leggiparametri(dbpercorsobase)

' =======

' leggi stringasqlbase

stringasqlbase = leggiparametri(dbstringasql)

'

if esito = 0 then

esito = 0

call leggielencocartelledascansionare(dbcartelladascansionare)

end if

'

slog = "Terminato: " & Time

call ScriviFileJollyAppend(dbjollylog, slog)

' msgbox "terminato"

'

' =========

'

sub leggielencocartelledascansionare(Pfiledaleggere)

dim objFSO, objFile, strLine

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.OpenTextFile(pfiledaleggere, 1)

'

Do While objFile.AtEndOfStream = False

strLine = trim(objFile.ReadLine)

if len(strLine) > 0 then

nomefornitore = strLine

cartellainlavoro = percorsobase & strLine & "\"

'

set filenellacartella = ShowFileListTipo(cartellainlavoro, ".pdf")

'

tchiavi = filenellacartella.Keys

For Each tchiave In tchiavi

tcriterio = "\d{4}_" & trim(nomefornitore) & ".pdf"

risultato = RimouvoCodificati(tchiave, tcriterio)

Next

'

criterioricerca = leggiparametri(dbcartellaricerca & "ricerca-" & nomefornitore & ".txt")

'

tchiavi = filenellacartella.Keys

For Each tchiave In tchiavi

nomefileinricerca = tchiave

risultato = TrovaValore(tchiave, criterioricerca)

risultato = TrovaValore(risultato, "\d+")

if len(risultato) > 0 then

contofornitore = leggiparametri(cartellainlavoro & archiviocontofornitore)

call recuperadatiSQL(risultato)

if len(trim(contofornitore)) = 0 then

slog = cartellainlavoro & vbcrlf & archiviocontofornitore & vbcrlf & "contofornitore: " & contofornitore

call ScriviFileJollyAppend("C:\sistema-protocollo\manca-conto-fornitore.txt", slog)

end if



end if

Next

'

end if

Loop

'

'

end sub

' ========

' === estrae dati dal database ===

' ========

sub recuperadatiSQL(valoredatrovare)

dim SQLConn, conn, adoCmd, stringasql

dim rsj, estratti

dim nrdoc, partita, jnrdoc, lunghezza

' stringa di conn

SQLConn = "DSN=ODBC;DSN=#????#;UID=#????#;Database=#????#"

'

set conn = createobject("ADODB.Connection")

conn.open sqlconn

' time out

Set adoCmd = CreateObject("ADODB.Command")

adoCmd.CommandTimeout = 45

adoCmd.ActiveConnection = conn

'

stringasql = stringasqlbase

stringasql = replace(stringasql, "#contofornitore#", contofornitore)

stringasql = replace(stringasql, "#annoesercizio#", annosql)

stringasql = replace(stringasql, "#numerodacercare#", valoredatrovare)

'

if len(trim(contofornitore)) = 0 then

exit sub

end if

'

set rsj=CreateObject("ADODB.recordset")

rsj.Open stringasql, conn, 3, 3

estratti = rsj.RecordCount

'

if estratti = 1 then

nrdoc = trim(rsj(2).value)

'

jnrdoc = "000000000" & nrdoc

lunghezza = len(valoredatrovare)

jnrdoc = right(jnrdoc, lunghezza)

'

partita = "0000" & trim(rsj(3).value)

partita = right(partita,4)

if nrdoc = valoredatrovare then

call rinominafile(partita)

else

if jnrdoc = valoredatrovare then

call rinominafile(partita)

end if

end if

end if

'

end sub

'

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

'

Sub rinominafile(nuovonome)

dim FSO, strFile, strRename

Set FSO = CreateObject("Scripting.FileSystemObject")

strFile = cartellainlavoro & nomefileinricerca

strRename = cartellainlavoro & nuovonome & "_" & nomefornitore & ".PDF"

If FSO.FileExists(strFile) Then

If FSO.FileExists(strRename) = False THEN

FSO.MoveFile strFile, strRename

' msgbox strFile & vbcrlf & strRename

slog = "proposta rinomina: " & strFile & " : " & strRename

call ScriviFileJollyAppend("C:\sistema-protocollo\log-proposta-rinomina.txt", slog)

else

slog = "fattura doppia: " & strFile & ":" & strRename

call ScriviFileJollyAppend("C:\sistema-protocollo\log-fatture-doppie.txt", slog)

end if

End If

Set FSO = Nothing

End Sub

'

' ========

'

Function TrovaValore(strVal, comecercare) 'As String

Dim sParts, sPart, rPart 'As Object

Set rPart = CreateObject("VBScript.RegExp")

rPart.Global = True

rPart.IgnoreCase = True

rPart.pattern = comecercare '

'get the results

Set sParts = rPart.Execute(strVal)

'get the first match

For Each sPart In sParts

TrovaValore = sParts(0)

Exit For

Next 'sPart

Set sParts = Nothing

End Function

'

' ========

'

function RimouvoCodificati(strVal, comecercare) 'As String

Dim sParts, sPart, rPart 'As Object

Set rPart = CreateObject("VBScript.RegExp")

rPart.Global = True

rPart.IgnoreCase = True

rPart.pattern = comecercare '

'get the results

Set sParts = rPart.Execute(strVal)

'get the first match

For Each sPart In sParts

risultato = spart

if trim(strval) = trim(spart) then

filenellacartella.Remove(strVal)

end if

Next 'sPart

Set sParts = Nothing

End function

'

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

'

Sub ElencaDizionario(pdizionario)

Dim dizionarioj, chiavi, chiave, quantek

Set dizionarioj = CreateObject("Scripting.Dictionary")

dizionarioj.CompareMode = vbTextCompare

set dizionarioj = pdizionario

chiavi = dizionarioj.Keys

quantek = dizionarioj.count

'

For Each chiave In chiavi

call ScriviFileJollyAppend("C:\sistema-protocollo\a-d3.txt", chiave)

Next

'

End Sub

'

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

'

Function ShowFileListTipo(folderspec, tipofile)

'

Dim fso, f, f1, fc, s, snome, suffisso, tchiavi, tquantek

'

Dim Tfilenellacartella

Set Tfilenellacartella = CreateObject("Scripting.Dictionary")

Tfilenellacartella.CompareMode = vbTextCompare

'

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFolder(folderspec)

Set fc = f.Files

For Each f1 In fc

snome = f1.Name

'

if len(ucase(snome)) > len(ucase(tipofile)) then

suffisso = right(snome, len(tipofile))

if ucase(suffisso) = ucase(tipofile) then

if ucase(trim(f1.Name)) = trim(ucase("fatturetutte.pdf")) then

else

If Tfilenellacartella.Exists(f1.Name) = False Then

Tfilenellacartella.Add f1.Name, True

End If

end if

end if

end if

Next

'

set ShowFileListTipo = Tfilenellacartella

tchiavi = Tfilenellacartella.Keys

tquantek = Tfilenellacartella.count

'

End Function

'

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

'

function leggiparametri(sFilePathAndName)

dim sFileContents, oFS, oTextStream

Set oFS = CreateObject("Scripting.FileSystemObject")

If oFS.FileExists(sFilePathAndName) = True Then

Set oTextStream = oFS.OpenTextFile(sFilePathAndName,1)

sFileContents = trim(oTextStream.ReadAll)

oTextStream.Close

Set oTextStream = nothing

else

esito = esito + 1

End if

Set oFS = nothing

leggiparametri = sFileContents

'

if len(sFileContents) = 0 then

esito = esito + 1

end if

'

end function

'

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

'

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

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

' === ===

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