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

'

' =========

'