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

'

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

'