'
'
option explicit
'
dim cartellaprocedura, cartellalavoro, dbstringhesql, contenutostringhe, cartellaprg
'
dim daticorrenti, datiprima, nomereportcorrente, fileflag
dim prgreport, prgemail, prgcompara, prgcontatore, cazione
dim rsj, estratti
dim dizionario
Set dizionario = CreateObject("Scripting.Dictionary")
dizionario.CompareMode = vbTextCompare
'
' ===================
cartellaprocedura = "\\azioniprogrammate\dichiarazioni-intento\"
' ======================
cartellalavoro = cartellaprocedura
cartellaprg = cartellaprocedura
'
nomereportcorrente = "rep-dati-correnti.html"
daticorrenti = cartellalavoro & nomereportcorrente
datiprima = cartellalavoro & "rep-dati-prima.html"
fileflag = cartellalavoro & "solo-nel-file-" & nomereportcorrente
'
dbstringhesql = cartellaprocedura & "db-stringhe-sql.txt"
'
'
prgreport = "\\azioniprogrammate\modelli\jolly-esegui-sql-scrivi-report.vbs"
prgcompara = "\\azioniprogrammate\modelli\comparazione-due-file.vbs"
prgemail = "\\azioniprogrammate\modelli\prg-report-email\prg-db-email-corpo-invia-email-html.vbs"
prgcontatore = "\\azioniprogrammate\modelli\gestione-contatore.vbs"
'
'
call verificasecrearefile(daticorrenti)
call verificasecrearefile(datiprima)
'
call elencafiledb(dbstringhesql, "cancella") ' cancella file precedenti
'
call leggistringhesql(dbstringhesql)
'
call elencafiledb(dbstringhesql, "carica")
'
call scrividizionario(daticorrenti)
'
cazione = ""
cazione = cazione & prgcompara & " "
cazione = cazione & daticorrenti & " "
cazione = cazione & datiprima & " "
'
call chiamaprogramma(cazione)
'
call uniscifile(daticorrenti, datiprima)
'
' decidi di inviare email
call decidiinvioemail(fileflag)
' cancella i dati precedenti
call cancellafile(datiprima)
' copia il report attuale come precedente
call copiaFile(daticorrenti, datiprima)
'
' =====
'
sub decidiinvioemail(pfile)
'
dim fs
set fs=CreateObject("Scripting.FileSystemObject")
if fs.FileExists(pfile) = true then
' esiste
cazione = prgcontatore & " " & cartellaprg & " db-email-oggetto-modello.txt db-email-oggetto.txt "
call chiamaprogramma(cazione)
'
cazione = prgemail & " " & cartellaprg
call chiamaprogramma(cazione)
else
' non esiste
end if
'
set fs=nothing
'
end sub
'
' ===========
'
sub uniscifile(parchivio1, parchivio2)
dim dbemailcorpo, contenuto1, contenuto2, shtml
dbemailcorpo = cartellaprg & "db-email-corpo.txt"
'
contenuto1 = leggifiletutto(parchivio1, "niente")
'
contenuto2 = leggifiletutto(parchivio2, "niente")
'
'
shtml = ""
shtml = shtml & "<TABLE>"
shtml = shtml & "<TR><TD>variazioni: " & date & " - " & time & "</TD></TR>"
shtml = shtml & "<TR><TD>situazione attuale:</TD></TR>"
shtml = shtml & "<TR><TD>" & contenuto1 & "</TD></TR>"
shtml = shtml & "<TR><TD>situazione precedente:</TD></TR>"
shtml = shtml & "<TR><TD>" & contenuto2 & "</TD></TR>"
shtml = shtml & "</TABLE>"
'
'
call SovraScriviFile(dbemailcorpo, shtml)
'
end sub
'
' =========
'
sub elencafiledb(pfiledaleggere, pazione)
dim html, trovato, contali
html = leggifiletutto(pfiledaleggere, "togli")
'
dim righe, sriga, riga, valori, matches, match, tableText
'
dim sdata, svalore
'
Set righe=GetMatch(html,"<TR[^>]*>([\S\s]*?)</TR>")
'
contali = 0
For Each sriga In righe
riga = Trim(sriga.value)
set valori = GetMatch(riga,"<TD[^>]*>([\S\s]*?)</TD>")
If valori.count <> 0 Then
sdata = valori.Item(0).value
svalore = trim(StripHTML(valori.Item(1).value))
contali = contali +1
'
if pazione = "cancella" then
call cancellafile(svalore)
end if
'
if pazione = "carica" then
if contali = 1 then
call CreaDizionarioBase(svalore, "no")
else
call leggiNelDizionario(svalore, "si")
end if
end if
'
End If
'
'
Next
'
end sub
'
' =======
'
Sub chiamaprogramma(ppassato)
Dim objShell, attesa, azione
Set objShell = Wscript.CreateObject("WScript.Shell")
'
azione = ppassato
'
attesa = objShell.Run(azione, 1, true)
'
end sub
'
' =======================
'
sub verificasecrearefile(pfile)
dim fs
set fs=CreateObject("Scripting.FileSystemObject")
if fs.FileExists(pfile) = true then
' esiste
else
' non esiste
call SovraScriviFile(pfile, " ")
end if
set fs=nothing
end sub
'
' ==============
'
sub scrividizionario(pfiledascrivere)
dim a, chiave, valore, stesto, i
'
stesto = ""
stesto = stesto & "<TABLE BORDER='1'>" & vbcrlf
stesto = stesto & "<TR>"
stesto = stesto & "<TD>codice</TD>"
stesto = stesto & "<TD>fatt.immediate da contabilizzare</TD>"
stesto = stesto & "<TD>ddt da fatturare</TD>"
stesto = stesto & "<TD>totale vendite</TD>"
stesto = stesto & "<TD>imporo acquistabile</TD>"
stesto = stesto & "<TD>cliente</TD>"
'
stesto = stesto & "<TR>"
'
call SovraScriviFile(pfiledascrivere, stesto)
'
a=dizionario.Keys
for i=0 to dizionario.Count-1
chiave = a(i)
valore = dizionario.item(chiave)
stesto = "<TR>" & chiave & valore & "</TR>"
call ScriviFileJollyAppend(pfiledascrivere, stesto)
next
'
stesto = "</TABLE>"
call ScriviFileJollyAppend(pfiledascrivere, stesto)
'
end sub
'
' =======
'
sub copiaFile(ifile, ofile)
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
'
option explicit
'
dim cartellaprocedura, cartellalavoro, dbstringhesql, contenutostringhe, cartellaprg
'
dim daticorrenti, datiprima, nomereportcorrente, fileflag
dim prgreport, prgemail, prgcompara, prgcontatore, cazione
dim rsj, estratti
dim dizionario
Set dizionario = CreateObject("Scripting.Dictionary")
dizionario.CompareMode = vbTextCompare
'
' ===================
cartellaprocedura = "\\azioniprogrammate\dichiarazioni-intento\"
' ======================
cartellalavoro = cartellaprocedura
cartellaprg = cartellaprocedura
'
nomereportcorrente = "rep-dati-correnti.html"
daticorrenti = cartellalavoro & nomereportcorrente
datiprima = cartellalavoro & "rep-dati-prima.html"
fileflag = cartellalavoro & "solo-nel-file-" & nomereportcorrente
'
dbstringhesql = cartellaprocedura & "db-stringhe-sql.txt"
'
'
prgreport = "\\azioniprogrammate\modelli\jolly-esegui-sql-scrivi-report.vbs"
prgcompara = "\\azioniprogrammate\modelli\comparazione-due-file.vbs"
prgemail = "\\azioniprogrammate\modelli\prg-report-email\prg-db-email-corpo-invia-email-html.vbs"
prgcontatore = "\\azioniprogrammate\modelli\gestione-contatore.vbs"
'
'
call verificasecrearefile(daticorrenti)
call verificasecrearefile(datiprima)
'
call elencafiledb(dbstringhesql, "cancella") ' cancella file precedenti
'
call leggistringhesql(dbstringhesql)
'
call elencafiledb(dbstringhesql, "carica")
'
call scrividizionario(daticorrenti)
'
cazione = ""
cazione = cazione & prgcompara & " "
cazione = cazione & daticorrenti & " "
cazione = cazione & datiprima & " "
'
call chiamaprogramma(cazione)
'
call uniscifile(daticorrenti, datiprima)
'
' decidi di inviare email
call decidiinvioemail(fileflag)
' cancella i dati precedenti
call cancellafile(datiprima)
' copia il report attuale come precedente
call copiaFile(daticorrenti, datiprima)
'
' =====
'
sub decidiinvioemail(pfile)
'
dim fs
set fs=CreateObject("Scripting.FileSystemObject")
if fs.FileExists(pfile) = true then
' esiste
cazione = prgcontatore & " " & cartellaprg & " db-email-oggetto-modello.txt db-email-oggetto.txt "
call chiamaprogramma(cazione)
'
cazione = prgemail & " " & cartellaprg
call chiamaprogramma(cazione)
else
' non esiste
end if
'
set fs=nothing
'
end sub
'
' ===========
'
sub uniscifile(parchivio1, parchivio2)
dim dbemailcorpo, contenuto1, contenuto2, shtml
dbemailcorpo = cartellaprg & "db-email-corpo.txt"
'
contenuto1 = leggifiletutto(parchivio1, "niente")
'
contenuto2 = leggifiletutto(parchivio2, "niente")
'
'
shtml = ""
shtml = shtml & "<TABLE>"
shtml = shtml & "<TR><TD>variazioni: " & date & " - " & time & "</TD></TR>"
shtml = shtml & "<TR><TD>situazione attuale:</TD></TR>"
shtml = shtml & "<TR><TD>" & contenuto1 & "</TD></TR>"
shtml = shtml & "<TR><TD>situazione precedente:</TD></TR>"
shtml = shtml & "<TR><TD>" & contenuto2 & "</TD></TR>"
shtml = shtml & "</TABLE>"
'
'
call SovraScriviFile(dbemailcorpo, shtml)
'
end sub
'
' =========
'
sub elencafiledb(pfiledaleggere, pazione)
dim html, trovato, contali
html = leggifiletutto(pfiledaleggere, "togli")
'
dim righe, sriga, riga, valori, matches, match, tableText
'
dim sdata, svalore
'
Set righe=GetMatch(html,"<TR[^>]*>([\S\s]*?)</TR>")
'
contali = 0
For Each sriga In righe
riga = Trim(sriga.value)
set valori = GetMatch(riga,"<TD[^>]*>([\S\s]*?)</TD>")
If valori.count <> 0 Then
sdata = valori.Item(0).value
svalore = trim(StripHTML(valori.Item(1).value))
contali = contali +1
'
if pazione = "cancella" then
call cancellafile(svalore)
end if
'
if pazione = "carica" then
if contali = 1 then
call CreaDizionarioBase(svalore, "no")
else
call leggiNelDizionario(svalore, "si")
end if
end if
'
End If
'
'
Next
'
end sub
'
' =======
'
Sub chiamaprogramma(ppassato)
Dim objShell, attesa, azione
Set objShell = Wscript.CreateObject("WScript.Shell")
'
azione = ppassato
'
attesa = objShell.Run(azione, 1, true)
'
end sub
'
' =======================
'
sub verificasecrearefile(pfile)
dim fs
set fs=CreateObject("Scripting.FileSystemObject")
if fs.FileExists(pfile) = true then
' esiste
else
' non esiste
call SovraScriviFile(pfile, " ")
end if
set fs=nothing
end sub
'
' ==============
'
sub scrividizionario(pfiledascrivere)
dim a, chiave, valore, stesto, i
'
stesto = ""
stesto = stesto & "<TABLE BORDER='1'>" & vbcrlf
stesto = stesto & "<TR>"
stesto = stesto & "<TD>codice</TD>"
stesto = stesto & "<TD>fatt.immediate da contabilizzare</TD>"
stesto = stesto & "<TD>ddt da fatturare</TD>"
stesto = stesto & "<TD>totale vendite</TD>"
stesto = stesto & "<TD>imporo acquistabile</TD>"
stesto = stesto & "<TD>cliente</TD>"
'
stesto = stesto & "<TR>"
'
call SovraScriviFile(pfiledascrivere, stesto)
'
a=dizionario.Keys
for i=0 to dizionario.Count-1
chiave = a(i)
valore = dizionario.item(chiave)
stesto = "<TR>" & chiave & valore & "</TR>"
call ScriviFileJollyAppend(pfiledascrivere, stesto)
next
'
stesto = "</TABLE>"
call ScriviFileJollyAppend(pfiledascrivere, stesto)
'
end sub
'
' =======
'
sub copiaFile(ifile, ofile)
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile ifile, ofile
Set objFSO = Nothing
end sub
'
' ========================
'
sub cancellafile(pfilepassato)
dim fs
Set fs=CreateObject("Scripting.FileSystemObject")
if fs.FileExists(pfilepassato) then
fs.DeleteFile(pfilepassato)
end if
set fs=nothing
end sub
'
' =======================
'
sub CreaDizionarioBase(pfiledaleggere, xenumero)
dim html, trovato
html = leggifiletutto(pfiledaleggere, "togli")
'
dim righe, sriga, riga, valori, matches, match, tableText
'
dim sdata, svalore
'
Set righe=GetMatch(html,"<TR[^>]*>([\S\s]*?)</TR>")
'
For Each sriga In righe
riga = Trim(sriga.value)
set valori = GetMatch(riga,"<TD[^>]*>([\S\s]*?)</TD>")
If valori.count <> 0 Then
sdata = valori.Item(0).value
svalore = valori.Item(1).value
'
if xenumero = "si" then
svalore = "<TD align=""right"">" & formatnumber(StripHTML(svalore)) & "</TD>"
end if
'
if dizionario.Exists(sdata)= true then
' Response.Write("Key exists.")
else
' Response.Write("Key does not exist.")
dizionario.Add sdata, svalore
end if
End If
'
'
Next
'
'
end sub
'
' ==========
'
Sub leggiNelDizionario(pfiledaleggere, xenumero)
dim html, trovato
html = leggifiletutto(pfiledaleggere, "togli")
'
dim ldizionario
Set ldizionario = CreateObject("Scripting.Dictionary")
ldizionario.CompareMode = vbTextCompare
end sub
'
' ========================
'
sub cancellafile(pfilepassato)
dim fs
Set fs=CreateObject("Scripting.FileSystemObject")
if fs.FileExists(pfilepassato) then
fs.DeleteFile(pfilepassato)
end if
set fs=nothing
end sub
'
' =======================
'
sub CreaDizionarioBase(pfiledaleggere, xenumero)
dim html, trovato
html = leggifiletutto(pfiledaleggere, "togli")
'
dim righe, sriga, riga, valori, matches, match, tableText
'
dim sdata, svalore
'
Set righe=GetMatch(html,"<TR[^>]*>([\S\s]*?)</TR>")
'
For Each sriga In righe
riga = Trim(sriga.value)
set valori = GetMatch(riga,"<TD[^>]*>([\S\s]*?)</TD>")
If valori.count <> 0 Then
sdata = valori.Item(0).value
svalore = valori.Item(1).value
'
if xenumero = "si" then
svalore = "<TD align=""right"">" & formatnumber(StripHTML(svalore)) & "</TD>"
end if
'
if dizionario.Exists(sdata)= true then
' Response.Write("Key exists.")
else
' Response.Write("Key does not exist.")
dizionario.Add sdata, svalore
end if
End If
'
'
Next
'
'
end sub
'
' ==========
'
Sub leggiNelDizionario(pfiledaleggere, xenumero)
dim html, trovato
html = leggifiletutto(pfiledaleggere, "togli")
'
dim ldizionario
Set ldizionario = CreateObject("Scripting.Dictionary")
ldizionario.CompareMode = vbTextCompare
dim righe, sriga, riga, valori, matches, match, tableText
'
dim sdata, svalore
'
Set righe=GetMatch(html,"<TR[^>]*>([\S\s]*?)</TR>")
'
For Each sriga In righe
riga = Trim(sriga.value)
set valori = GetMatch(riga,"<TD[^>]*>([\S\s]*?)</TD>")
If valori.count <> 0 Then
sdata = valori.Item(0).value
svalore = valori.Item(1).value
'
if xenumero = "si" then
svalore = "<TD align=""right"">" & formatnumber(StripHTML(svalore)) & "</TD>"
end if
'
'msgbox sdata & vbcrlf & svalore
if ldizionario.Exists(sdata)= true then
' Response.Write("Key exists.")
else
' Response.Write("Key does not exist.")
ldizionario.Add sdata, svalore
end if
End If
'
Next
'
'
dim a, i, s, v, ev, nv, ve
'
a=dizionario.Keys
for i = 0 To dizionario.Count -1
s = a(i)
v = dizionario.item(s)
'
if ldizionario.exists(s) = true then
ve = ldizionario.item(s)
nv = ve & v
dizionario.item(s) = nv
else
dizionario.item(s) = "<TD align=""right"">0</TD>" & v
end if
'
next
'
'
end sub
'
' =================================
'
sub leggistringhesql(pfiledaleggere)
dim html, trovato
html = leggifiletutto(pfiledaleggere, "togli")
'
dim righe, sriga, riga, valori, matches, match, tableText
'
dim lstringasql, lreport
'
Set righe=GetMatch(html,"<TR[^>]*>([\S\s]*?)</TR>")
'
For Each sriga In righe
riga = Trim(sriga.value)
set valori = GetMatch(riga,"<TD[^>]*>([\S\s]*?)</TD>")
If valori.count <> 0 Then
lstringasql = StripHTML(valori.Item(0).value)
lreport = trim(StripHTML(valori.Item(1).value))
'
'
call recuperadatiSQLSRL(lstringasql)
call ElencaDatiEstratti(lreport)
'
End If
'
'
Next
'
'
end sub
'
' === estrae dati dal database ==========
'
sub recuperadatiSQLSRL(pstringasql)
dim SQLConn, conn, adoCmd, strSQL
' stringa di conn
SQLConn = "DSN=ODBC;DSN=wwww;UID=wwww;Database=wwww"
'
set conn = createobject("ADODB.Connection")
conn.open sqlconn
' time out
Set adoCmd = CreateObject("ADODB.Command")
adoCmd.CommandTimeout = 45
adoCmd.ActiveConnection = conn
'
strSQL = pstringasql
'
set rsj=CreateObject("ADODB.recordset")
rsj.Open strSQL, conn, 3, 3
estratti = rsj.RecordCount
'
' msgbox "estratti: " & estratti
'
end sub
'
' ===== test Elenca Dati Estratti - sql ======
'
Sub ElencaDatiEstratti(pdovescrivere)
dim rs, intestazione, nrcampi, i, stxt, xslog
set rs = rsj
nrcampi = RS.Fields.Count - 1
stxt = ""
stxt = stxt & "<TABLE border=1><TR>"
For i = 0 to RS.Fields.Count - 1
stxt = stxt & "<TH>" & rs(i).Name & "</TH>"
Next
stxt = stxt & "</TR>" '& vbcrlf
xslog = stxt
call ScriviFileJollyAppend(pdovescrivere, xslog)
'
Do until rs.Eof
'
stxt = ""
stxt = stxt & "<TR>" ' & vbcrlf
For i = 0 to RS.Fields.Count - 1
stxt = stxt & "<TD>" & rs(i).Value & "</TD>"
Next
stxt = stxt & "</TR>" '& vbcrlf
xslog = stxt
call ScriviFileJollyAppend(pdovescrivere, xslog)
'
dim sdata, svalore
'
Set righe=GetMatch(html,"<TR[^>]*>([\S\s]*?)</TR>")
'
For Each sriga In righe
riga = Trim(sriga.value)
set valori = GetMatch(riga,"<TD[^>]*>([\S\s]*?)</TD>")
If valori.count <> 0 Then
sdata = valori.Item(0).value
svalore = valori.Item(1).value
'
if xenumero = "si" then
svalore = "<TD align=""right"">" & formatnumber(StripHTML(svalore)) & "</TD>"
end if
'
'msgbox sdata & vbcrlf & svalore
if ldizionario.Exists(sdata)= true then
' Response.Write("Key exists.")
else
' Response.Write("Key does not exist.")
ldizionario.Add sdata, svalore
end if
End If
'
Next
'
'
dim a, i, s, v, ev, nv, ve
'
a=dizionario.Keys
for i = 0 To dizionario.Count -1
s = a(i)
v = dizionario.item(s)
'
if ldizionario.exists(s) = true then
ve = ldizionario.item(s)
nv = ve & v
dizionario.item(s) = nv
else
dizionario.item(s) = "<TD align=""right"">0</TD>" & v
end if
'
next
'
'
end sub
'
' =================================
'
sub leggistringhesql(pfiledaleggere)
dim html, trovato
html = leggifiletutto(pfiledaleggere, "togli")
'
dim righe, sriga, riga, valori, matches, match, tableText
'
dim lstringasql, lreport
'
Set righe=GetMatch(html,"<TR[^>]*>([\S\s]*?)</TR>")
'
For Each sriga In righe
riga = Trim(sriga.value)
set valori = GetMatch(riga,"<TD[^>]*>([\S\s]*?)</TD>")
If valori.count <> 0 Then
lstringasql = StripHTML(valori.Item(0).value)
lreport = trim(StripHTML(valori.Item(1).value))
'
'
call recuperadatiSQLSRL(lstringasql)
call ElencaDatiEstratti(lreport)
'
End If
'
'
Next
'
'
end sub
'
' === estrae dati dal database ==========
'
sub recuperadatiSQLSRL(pstringasql)
dim SQLConn, conn, adoCmd, strSQL
' stringa di conn
SQLConn = "DSN=ODBC;DSN=wwww;UID=wwww;Database=wwww"
'
set conn = createobject("ADODB.Connection")
conn.open sqlconn
' time out
Set adoCmd = CreateObject("ADODB.Command")
adoCmd.CommandTimeout = 45
adoCmd.ActiveConnection = conn
'
strSQL = pstringasql
'
set rsj=CreateObject("ADODB.recordset")
rsj.Open strSQL, conn, 3, 3
estratti = rsj.RecordCount
'
' msgbox "estratti: " & estratti
'
end sub
'
' ===== test Elenca Dati Estratti - sql ======
'
Sub ElencaDatiEstratti(pdovescrivere)
dim rs, intestazione, nrcampi, i, stxt, xslog
set rs = rsj
nrcampi = RS.Fields.Count - 1
stxt = ""
stxt = stxt & "<TABLE border=1><TR>"
For i = 0 to RS.Fields.Count - 1
stxt = stxt & "<TH>" & rs(i).Name & "</TH>"
Next
stxt = stxt & "</TR>" '& vbcrlf
xslog = stxt
call ScriviFileJollyAppend(pdovescrivere, xslog)
'
Do until rs.Eof
'
stxt = ""
stxt = stxt & "<TR>" ' & vbcrlf
For i = 0 to RS.Fields.Count - 1
stxt = stxt & "<TD>" & rs(i).Value & "</TD>"
Next
stxt = stxt & "</TR>" '& vbcrlf
xslog = stxt
call ScriviFileJollyAppend(pdovescrivere, xslog)
'
rs.MoveNext
Loop
'
xslog = "</TABLE>" & vbcrlf
call ScriviFileJollyAppend(pdovescrivere, xslog)
'
End Sub
'
' =================
'
Function StripHTML(cell)
Dim RegEx 'As Object
Set RegEx = CreateObject("vbscript.regexp")
Dim sInput 'As String
Dim sOut 'As String
sInput = cell
'
With RegEx
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = "<[^>]+>" 'Regular Expression for HTML Tags.
End With
sOut = RegEx.Replace(sInput, "")
StripHTML = sOut
Set RegEx = Nothing
'
End Function
'
' === leggi stringa sql ===================
'
function leggifiletutto(sFilePathAndName, pazione)
dim contenutoletto
dim sFileContents, oFS, oTextStream
Set oFS = CreateObject("Scripting.FileSystemObject")
If oFS.FileExists(sFilePathAndName) = True Then
Set oTextStream = oFS.OpenTextFile(sFilePathAndName,1)
sFileContents = oTextStream.ReadAll
oTextStream.Close
Set oTextStream = nothing
else
' msgbox "non trovato: " & sFilePathAndName
End if
Set oFS = nothing
contenutoletto = sFileContents
if pazione = "togli" then
contenutoletto = replace(contenutoletto, vbcrlf, " ")
contenutoletto = replace(contenutoletto, vbcr, " ")
contenutoletto = replace(contenutoletto, vblf, " ")
end if
'
leggifiletutto = contenutoletto
'
end function
'
' ====
'
Function GetMatch(strString,strPattern)
Dim RegEx, arrMatches, colMatches
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.IgnoreCase = True
RegEx.Global=True
RegEx.Pattern=strPattern
Set colMatches=RegEx.Execute(strString)
Set GetMatch=colMatches
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
'
' ===== Scrivi file Jolly Append ==========
'
Sub ScriviFileJollyAppend(NomeArchivio, cosascrivere)
'
'
dim fso, rifefile
Set fso=CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(NomeArchivio)) Then
'msg = filespec & " exists."
Set rifefile = fso.OpenTextFile(NomeArchivio, 8)
Else
'msg = filespec & " doesn't exist."
Set rifefile = fso.CreateTextFile(NomeArchivio, TRUE)
End If
rifefile.WriteLine(cosascrivere)
rifefile.Close
set rifefile = Nothing
End Sub
'
' ====================
'
rs.MoveNext
Loop
'
xslog = "</TABLE>" & vbcrlf
call ScriviFileJollyAppend(pdovescrivere, xslog)
'
End Sub
'
' =================
'
Function StripHTML(cell)
Dim RegEx 'As Object
Set RegEx = CreateObject("vbscript.regexp")
Dim sInput 'As String
Dim sOut 'As String
sInput = cell
'
With RegEx
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = "<[^>]+>" 'Regular Expression for HTML Tags.
End With
sOut = RegEx.Replace(sInput, "")
StripHTML = sOut
Set RegEx = Nothing
'
End Function
'
' === leggi stringa sql ===================
'
function leggifiletutto(sFilePathAndName, pazione)
dim contenutoletto
dim sFileContents, oFS, oTextStream
Set oFS = CreateObject("Scripting.FileSystemObject")
If oFS.FileExists(sFilePathAndName) = True Then
Set oTextStream = oFS.OpenTextFile(sFilePathAndName,1)
sFileContents = oTextStream.ReadAll
oTextStream.Close
Set oTextStream = nothing
else
' msgbox "non trovato: " & sFilePathAndName
End if
Set oFS = nothing
contenutoletto = sFileContents
if pazione = "togli" then
contenutoletto = replace(contenutoletto, vbcrlf, " ")
contenutoletto = replace(contenutoletto, vbcr, " ")
contenutoletto = replace(contenutoletto, vblf, " ")
end if
'
leggifiletutto = contenutoletto
'
end function
'
' ====
'
Function GetMatch(strString,strPattern)
Dim RegEx, arrMatches, colMatches
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.IgnoreCase = True
RegEx.Global=True
RegEx.Pattern=strPattern
Set colMatches=RegEx.Execute(strString)
Set GetMatch=colMatches
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
'
' ===== Scrivi file Jolly Append ==========
'
Sub ScriviFileJollyAppend(NomeArchivio, cosascrivere)
'
'
dim fso, rifefile
Set fso=CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(NomeArchivio)) Then
'msg = filespec & " exists."
Set rifefile = fso.OpenTextFile(NomeArchivio, 8)
Else
'msg = filespec & " doesn't exist."
Set rifefile = fso.CreateTextFile(NomeArchivio, TRUE)
End If
rifefile.WriteLine(cosascrivere)
rifefile.Close
set rifefile = Nothing
End Sub
'
' ====================
'
