prg articoli invia vendite - vbs

' trasf

option explicit

'

'

dim cartellaprocedura

cartellaprocedura = "C:\articoli-invia-vendite\"

'

dim dataoggi

dataoggi = date

'

dim dbconfigxml, jarchivio

dbconfigxml = cartellaprocedura & "config-temp.xml"

'

dim dizionario, dizionariochiave, dizionariovalore

set dizionario=CreateObject("Scripting.Dictionary")

dizionario.CompareMode=1

'

call leggixml(dbconfigxml, "parametri")

'

dim dataprima, dalladata, alladata

dataprima = dizionario.Item("data_ultima_scansione")

'

dataprima = DateAdd("d", 1, dataprima)

dalladata = sistemadata(dataprima)

alladata = sistemadata(dataoggi)

'

dim dbiniziali, iniziali, testodacambiare

dbiniziali = cartellaprocedura & "db-iniziali-articolo.txt"

iniziali = fleggitutto(dbiniziali)

'

call scriviconfigxml

'

'

dim campodacambiare

jarchivio = cartellaprocedura & dizionario.Item("file_input")

testodacambiare = fleggitutto(jarchivio)

'

call leggixml(dbconfigxml, "cose_da_cambiare")

'

jarchivio = cartellaprocedura & dizionario.Item("file_output")

call SovraScriviFile(jarchivio, testodacambiare)

'

'

' ====

'

sub leggixml(parchivioxml, ptiponodo)

Dim objDOM, rtResult, nodeList, obj, jnodo

Set objDOM = WScript.CreateObject("MSXML2.DOMDocument")

rtResult = objDOM.load(parchivioxml)

jnodo = "//*/" & ptiponodo & "/*"

If rtResult = True Then

Set nodeList = objDOM.documentElement.selectNodes(jnodo)

For Each obj In nodeList

dizionariochiave = obj.nodeName

dizionariovalore = obj.text

'

if dizionario.Exists(dizionariochiave) = true then

' Response.Write("Key exists!")

else

' Response.Write("Key does not exist!")

dizionario.Add dizionariochiave, dizionariovalore

end if

'

if ptiponodo = "cose_da_cambiare" then

campodacambiare = "<#>" & dizionariochiave & "<#>"

testodacambiare = replace(testodacambiare, campodacambiare, dizionariovalore)

end if

Next

End If

Set objDOM = Nothing

end sub

'

' ====

'

sub scriviconfigxml()

'

dim nomerecord

'

call SovraScriviFile(dbconfigxml, "<root>" & vbcrlf & "</root>")

'

nomerecord = "parametri"

call inseriscidatixml(dbconfigxml, nomerecord, "file_input", "db-stringa-sql-modello.txt")

call inseriscidatixml(dbconfigxml, nomerecord, "file_output", "db-stringa-sql.txt")

call inseriscidatixml(dbconfigxml, nomerecord, "data_ultima_scansione", dataoggi)

'

nomerecord = "cose_da_cambiare"

call inseriscidatixml(dbconfigxml, nomerecord, "dalla_data", dalladata)

call inseriscidatixml(dbconfigxml, nomerecord, "alla_data" , alladata)

call inseriscidatixml(dbconfigxml, nomerecord, "iniziali" , iniziali)

'

'

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 sistemadata(pdata)

dim jgg, jmm

'

jgg = "00" & day(pdata)

jgg = right(jgg, 2)

jmm = "00" & month(pdata)

jmm = right(jmm, 2)

sistemadata = year(pdata) & "-" & jmm & "-" & jgg

'

'

end function

'

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

'

function fleggitutto(pfiledaleggere)

'

dim objFSO, objFile, contenutoletto

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

fleggitutto = contenutoletto

Else

'esistefile = "no"

fleggitutto = "x-no-x"

End If

Set objFSO = Nothing

'

end function

'

' =========== lavora file xml ===========

'

sub inseriscidatixml(pfilexml, precord, pnomecampo, pvalore)

'

Dim doc, root, cosainserire, rigainserire

dim livello2, livello3

'

set doc = LoadXmldoc(pfilexml)

set root = Doc.documentElement

'

Set livello2 = doc.documentElement.selectSingleNode("//" & precord)

if livello2 is Nothing then

Set livello2 = doc.createNode("element", precord, "")

end if

'

cosainserire = vbcrlf & "<" & pnomecampo & ">" & pvalore & "</" & pnomecampo & ">" & vbcrlf

set rigainserire = LoadXmlstringa(cosainserire)

set livello3 = rigainserire.documentElement

livello2.appendChild(livello3)

'

root.appendChild(livello2)

'

doc.save (pfilexml)

'

'

end sub

'

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

'

Function LoadXmldoc(path)

'

Set LoadXmldoc = CreateObject("MSXML2.DomDocument.6.0")



LoadXmlDoc.async = False

LoadXmlDoc.load path

If LoadXmlDoc.parseError.errorCode <> 0 Then

WScript.Echo "Error in XML file."

WScript.Echo LoadXmlDoc.parseError.reason

WScript.Quit 1

End If

'

'

End Function

'

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

'

Function LoadXmlstringa(path)

'

Set LoadXmlstringa = CreateObject("MSXML2.DomDocument.6.0")

LoadXmlstringa.async = False

LoadXmlstringa.loadXML path

'

'

End Function

'

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

'

'

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

'

cartelle modello scansiona tag nome file - vbs

' p

Option explicit

'

dim fso: set fso = CreateObject("Scripting.FileSystemObject")

dim CurrentDirectory

CurrentDirectory = fso.GetAbsolutePathName(".")

'

dim cartelladascansionare, dbcartellaprocedura, esito

dbcartellaprocedura = CurrentDirectory & "\" ' "C:\da-pub\"

'cartelladascansionare = leggiparametri(dbcartellaprocedura & "cartella-da-scansionare.txt")

cartelladascansionare = dbcartellaprocedura

'

dim fileescluso

fileescluso = "ceram.jpg"

'

dim dblog, slog

dblog = dbcartellaprocedura & "note.txt"

'

slog = "tag: " & vbcrlf

call SovraScriviFile(dblog, slog)

'

Dim dizionario, chiave

Set dizionario = CreateObject("Scripting.Dictionary")

dizionario.CompareMode = vbTextCompare

'

call PrgElencaCartelletipo(cartelladascansionare, "jpg")

'

' srivi tag

'

dim a, i

a=dizionario.Keys

for i = 0 To dizionario.Count -1

slog = a(i)

if isnumeric(slog) = false then

call ScriviFileJollyAppend(dblog, slog)

end if

next

'

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

'

Sub PrgElencaCartelletipo(pFolder, ptipofile)

'

Dim fso, cartelle, percorsocartella, nomecartella, nomefile

dim SubFolder, File, tpath

Set fso = CreateObject("Scripting.FileSystemObject")

set Cartelle = fso.GetFolder(pFolder)

'

For Each File In fso.GetFolder(pFolder).Files

If UCASE(fso.GetExtensionName(File.Name)) = UCASE(ptipofile) Then

nomefile = File.Name

if ucase(nomefile) = ucase(fileescluso) then

else

tpath = percorsocartella & nomefile

' slog = "File.Name: " & File.Name & vbcrlf & tpath

nomefile = replace(nomefile, "-", " ")

nomefile = replace(nomefile, ".jpg", ".")

slog = "- " & nomefile & vbcrlf

call ScriviFileJollyAppend(dblog, slog)

' tag

call RicercaRisultato(nomefile, "\w+")

'

end if

End If

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

chiave = trim(spart)

If dizionario.Exists(chiave) = False Then

dizionario.Add chiave, chiave

else

End If

Next 'sPart

Set sParts = Nothing

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

'

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

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

' === fine ===

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

suddividi listino metel per marchio prodotto - vbs

' p

' suddivide un listino Metel.

' divide un file listino Metel in mase al marchio prodotto.

' crea, nella stessa cartella di origine del file, archivi con il nome:

' <sigla produttore> - <sigla marchio> - da - <nome file di origine>

'

option explicit

'

dim objArgs, Filename

'

Set objArgs = WScript.Arguments 'Vedo se ci sono degli argomenti passati allo script

if objargs.count=0 then 'altrimenti mostro come si usa il programma

msgbox "Trascinare un file sul programma per visualizzarlo", vbinformation+vbokonly, Title

wscript.quit

end if

'

Filename=wscript.arguments(0)

'

dim objFSO, objFile, nomefile

'

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.GetFile(Filename)

'

dim cartellalavori

cartellalavori = objFSO.GetParentFolderName(objFile) & "\"

nomefile = objFSO.GetFileName(Filename)

'

dim dblog, slog

'

dim sigliaproduttore, siglamarchio

'

' dizionario dei file creati per evitare di accodare dati a file già esistenti

Dim dizionariofilecreati, chiave

Set dizionariofilecreati = CreateObject("Scripting.Dictionary")

dizionariofilecreati.CompareMode = vbTextCompare

'

Dim fso, Text, txtStream, testata

'

Set fso = CreateObject("Scripting.FileSystemObject")

'

If fso.FileExists(Filename) = true Then

Set txtStream = fso.OpenTextFile(Filename) ' Apre file di testo.

testata = txtStream.ReadLine 'legge la prima riga che contiene la testata

sigliaproduttore = mid(testata, 21, 3)

Do While Not (txtStream.atEndOfStream)

Text = txtStream.ReadLine 'legge una riga

'

siglamarchio = mid(text, 1, 3)

'

dblog = cartellalavori & sigliaproduttore & "-" & siglamarchio & "-da-" & nomefile

'

' verifica iniziale se un file con il nome analogo esiste, se esiste lo cancella

chiave = dblog

If dizionariofilecreati.Exists(chiave) = False Then

dizionariofilecreati.Add chiave, chiave

call SovraScriviFile(dblog, testata)

else

End If

'

slog = Text

call ScriviFileJollyAppend(dblog, slog)

'

Loop

End If

'

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

rifefile.WriteLine(testata)

End If

rifefile.WriteLine(pcosascrivere)

rifefile.Close

set rifefile = Nothing

End Sub

'

' =========

'

sposta per nome file - vbs

'p

Option explicit

'

dim tipofile, suffisso

tipofile = "jpg"

suffisso = "." & tipofile

'

dim fso: set fso = CreateObject("Scripting.FileSystemObject")

dim CurrentDirectory

CurrentDirectory = fso.GetAbsolutePathName(".")

'

dim cartelladascansionare, dbcartellaprocedura, esito

dbcartellaprocedura = CurrentDirectory & "\" ' "C:\da-pub\"

cartelladascansionare = dbcartellaprocedura

'

dim dblog, slog, parolachiave

dblog = dbcartellaprocedura & "log-lavori.txt"

'

' parola presente nel nome file

parolachiave = inputbox("parola cercata", "parola cercata", " ")

'

dim cartelladestinazione

cartelladestinazione = dbcartellaprocedura & parolachiave & "\"

msgbox ReportFolderStatus(cartelladestinazione)

'

call PrgElencaCartelletipo(cartelladascansionare, tipofile)

'

Function ReportFolderStatus(cartelladestinazione)

Dim fso, msg, f

Set fso = CreateObject("Scripting.FileSystemObject")

If (fso.FolderExists(cartelladestinazione)) Then

msg = cartelladestinazione & " exists."

Else

msg = cartelladestinazione & " doesn't exist."

Set f = fso.CreateFolder(cartelladestinazione)

End If

ReportFolderStatus = msg

End Function

'

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

'

Sub PrgElencaCartelletipo(pFolder, ptipofile)

'

Dim fso, cartelle, percorsocartella, nomecartella, nomefile

dim SubFolder, File, tpath, presente

Set fso = CreateObject("Scripting.FileSystemObject")

set Cartelle = fso.GetFolder(pFolder)

'

For Each File In fso.GetFolder(pFolder).Files

If UCASE(fso.GetExtensionName(File.Name)) = UCASE(ptipofile) Then

nomefile = File.Name

tpath = percorsocartella & nomefile

presente = instr(ucase(nomefile), ucase(parolachiave))

if presente > 0 then

' slog = "File.Name: " & File.Name & vbcrlf & tpath

nomefile = replace(nomefile, "-", " ")

nomefile = replace(nomefile, suffisso , ".")

slog = "- " & nomefile & vbcrlf

call ScriviFileJollyAppend(dblog, slog)

'

fso.MoveFile tpath, cartelladestinazione

end if

'

End If

Next

'

'

End Sub

'

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

'

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

'

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

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

' ===

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

Importa Metel cross reference - vbs

'

' carica il File Metel Cross Reference

'

Set OXl = createobject ("Excel.Application")

'

Set objArgs = WScript.Arguments 'Vedo se ci sono degli argomenti passati allo script

if objargs.count=0 then 'altrimenti mostro come si usa il programma

msgbox "Trascinare un file sul programma per visualizzarlo", vbinformation+vbokonly, Title

wscript.quit

end if

'

Filename=wscript.arguments(0)

'

dim archiviomacro

archiviomacro = "C:\macro-importazione-cross-reference.txt"

'

oXL.Visible = true

'oXL.workbooks.OpenText Filename,,,1,,,False,,True,,False,,,,"."

'''oXl.workbooks.add

set fichxl=oXL.workbooks.add

'

dim vir, ecomm

vir = chr(34)

ecomm = chr(38)

'

Set mdle = fichxl.VBProject.VBComponents.Add(1)

'

Dim fso, Text, testo, txtStream, conta

dim dacambiare

dacambiare = "#nomeFileDaImportare#"

conta = 3

'

Set fso = CreateObject("Scripting.FileSystemObject")

'

If fso.FileExists(archiviomacro) = true Then

Set txtStream = fso.OpenTextFile(archiviomacro) ' Apre file di testo.

Do While Not (txtStream.atEndOfStream)

Text = txtStream.ReadLine 'legge una riga

testo = replace(Text,dacambiare,Filename)

mdle.CodeModule.InsertLines conta, testo

conta = conta + 1

Loop

End If

'

oXL.Run "ImportaCrossReference"

'

wscript.quit

'*** End ***

'

'

'

' testo archiviomacro = "C:\macro-importazione-cross-reference.txt"

'

'

' macro importazione Metel cross reference.

'



Sub ImportaCrossReference()

'

'

'

With ActiveSheet.QueryTables.Add(Connection:= _

"TEXT;#nomeFileDaImportare#", Destination:=Range("A1"))

.Name = "DATIIMPORTATI"

.FieldNames = True

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.RefreshOnFileOpen = False

.RefreshStyle = xlInsertDeleteCells

.SavePassword = False

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.TextFilePromptOnRefresh = False

.TextFilePlatform = xlWindows

.TextFileStartRow = 1

.TextFileParseType = xlFixedWidth

.TextFileTextQualifier = xlTextQualifierDoubleQuote

.TextFileConsecutiveDelimiter = False

.TextFileTabDelimiter = True

.TextFileSemicolonDelimiter = False

.TextFileCommaDelimiter = False

.TextFileSpaceDelimiter = False

.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2)

.TextFileFixedColumnWidths = Array(3, 16, 3, 16, 1, 30, 30)

.Refresh BackgroundQuery:=False

End With

'

' intestazione

Range("A1").Value = "Sigla Marchio"

Range("B1").Value = "Codice Prodotto"

Range("C1").Value = "Sigla Marchio"

Range("D1").Value = "Codice Prodotto"

Range("E1").Value = "Funzione"

Range("F1").Value = "Note"

Range("G1").Value = "Filler"

'

Range("h1").Value = "descrizione_Funzione"

Range("h2").Value = "0=ABBINAMENTO - 1=ALTERNATIVA"



'

Sheets(ActiveSheet.Name).Select

Sheets(ActiveSheet.Name).Name = "Cross_Reference"

'

End Sub

'

'

'

salva allegati posta file pdf - vbs

'

option explicit

'

' salva gli allegati in formato pdf nella casella di posta in arrivo.

'

dim cartellaprocedura, dbdata, dboggettomessaggi, slog

cartellaprocedura = "C:\Pubblica\allegati-posta\"

dbdata = cartellaprocedura & "db-data-ultima-scansione.txt" ' parametro data ultima scansione eseguita

dboggettomessaggi = cartellaprocedura & "log-oggettomessaggi.txt" ' memorizza nome allegato e oggetto messagio

'

dim LocalPath, CartellaOutlook, AttachName

LocalPath = cartellaprocedura & "allegati\"

CartellaOutlook = "Posta in arrivo"

'

dim tipofile, suffisso, flagdata, primadata

tipofile = "pdf"

flagdata = 0

'

dim datapartenza, oggettomessaggio, differenza

datapartenza = leggiparametritogli(dbdata)

'

dim DataRicezioneEmail, NomeAllegato, sfile

'Dichiarazione costanti

Dim Outlook, olkInbox, olkItem, olkAttach

Const olFolderInbox = 6

'

'riferimenti casella

Set Outlook = CreateObject("Outlook.Application")

'Set olkInbox = OutLook.Session.GetDefaultFolder(olFolderInbox).Folders(CartellaOutlook)

Set olkInbox = OutLook.Session.GetDefaultFolder(olFolderInbox)



'Esegue anche se outlook è chiuso

Outlook.Session.Logon

'

'--- ciclo su tuute le email ----------------------------

'

For Each olkItem In olkInbox.Items

'DataRicezioneEmail = olkItem.ReceivedTime

DataRicezioneEmail = olkItem.CreationTime

oggettomessaggio = ucase(olkItem.Subject)

'

if flagdata = 0 then

call SovraScriviFile(dbdata, DataRicezioneEmail)

flagdata = 1

end if

'

differenza = DateDiff( "n", datapartenza, DataRicezioneEmail)

if differenza > 0 then

'

If olkItem.Attachments.Count > 0 Then

For Each olkAttach In olkItem.Attachments

' Salva allegato/allegati

NomeAllegato = olkAttach.FileName

suffisso = right(NomeAllegato, 3)

if ucase(suffisso) = ucase(tipofile) then

'olkAttach.SaveAsFile LocalPath & NomeAllegato

NomeAllegato = esistefile(NomeAllegato) ' verifica se esiste file dal nome analogo

olkAttach.SaveAsFile NomeAllegato ' salva allegato

'

slog = sfile & "|" & oggettomessaggio

call ScriviFileJollyAppend(dboggettomessaggi, slog)

'

end if

Next

End If

else

exit for

end if

Next

'

'------------------------------------------------------

'

Set Outlook = nothing

Set OlkInbox = nothing

'

wscript.quit

'

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

'

function esistefile(parchivio)

dim contali, archiviodaverificare

dim fs

archiviodaverificare = LocalPath & parchivio

esistefile = archiviodaverificare

sfile = parchivio

contali = 0

'

set fs=CreateObject("Scripting.FileSystemObject")

while fs.FileExists(archiviodaverificare) = true

contali = contali + 1

sfile = "esisteva-" & contali & "-" & parchivio

archiviodaverificare = LocalPath & sfile

wend

esistefile = archiviodaverificare

set fs=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

'

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

'

function leggiparametritogli(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



End if

Set oFS = nothing

sFileContents = replace(sFileContents, vbcrlf, "")

sFileContents = replace(sFileContents, vbcr, "")

sFileContents = replace(sFileContents, vblf, "")

leggiparametritogli = sFileContents

'

'

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

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

' === fine ===

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

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

'

' =========

'