Option Explicit
Sub Main
Dim sDir,Inizio,Fine,bPrimaFissa,bRigenera
'=========================================================================================
' questi valori servono per l'aggiornamento dell'archivio una volta fissati non cambiarli
'
Inizio = 9000'DataEstrToIdEstr(4,1,1986) ' estrazione iniziale in base ai propri metodi per esempio 3950
Fine = EstrazioniArchivio ' sempre fino all'ultima estrazione disponibile
'=======================================================================================
If MsgBox("Usare il criterio con la prima estrazione fissa ?",vbQuestion + vbYesNo) = vbYes Then
bPrimaFissa = True
Else
bPrimaFissa = False
End If
If MsgBox("Ricreare daccapo gli archivi virtuali ?",vbQuestion + vbYesNo) = vbYes Then
bRigenera = True
Else
bRigenera = False
End If
ReDim aNumPrimi(0)
Call AlimentaPrimi(aNumPrimi)
sDir = GetDirectoryAppData & "ArchiviVirtuali\"
If CreaDirectory(sDir) Then
Call GeneraArchiviVirtuali(sDir,Inizio ,Fine,bPrimaFissa,bRigenera,aNumPrimi)
If MsgBox("Visualizzare i file degli archivi virtuali prodotti ? (E' necessario excel)",vbQuestion + vbYesNo) = vbYes Then
Call GeneraFileCsv(sDir,aNumPrimi,bPrimaFissa ,Inizio )
End If
Else
MsgBox "Errore creazione directory sistemi virtuali"
End If
End Sub
Sub GeneraArchiviVirtuali(sDirArchivi,idPrimaEstr,idUltimaEstr,bPrimaEstrFissa,bRigenera,aNumPrimi)
Dim sFile,nBase,nBaseTmp,idEstr,e,r,nMoltiplicatore,sData,i
Dim sDataUltimaEstrArcVirt,nEstrTotArcVir
Dim idPrimaEstrToAddArchVirt
For i = 1 To UBound(aNumPrimi)
nBase = aNumPrimi(i)
sFile = GetNomeFileArchVirt(sDirArchivi,nBase,bPrimaEstrFissa ,idPrimaEstr)
If bRigenera Then
Call EliminaFile(sFile)
nEstrTotArcVir = 0
sDataUltimaEstrArcVirt = ""
idPrimaEstrToAddArchVirt = idPrimaEstr
Else
nEstrTotArcVir = QuantitaEstrazioniInFile(sFile)
sDataUltimaEstrArcVirt = GetDataEstrArchivioVirt(sFile,nEstrTotArcVir)
If sDataUltimaEstrArcVirt <> "" Then
idPrimaEstrToAddArchVirt = DataEstrToIdEstr(Day(sDataUltimaEstrArcVirt),Month(sDataUltimaEstrArcVirt),Year(sDataUltimaEstrArcVirt))
If idPrimaEstrToAddArchVirt > 0 Then idPrimaEstrToAddArchVirt = idPrimaEstrToAddArchVirt + 1
Else
idPrimaEstrToAddArchVirt = idPrimaEstr
End If
End If
If idPrimaEstrToAddArchVirt > 0 Then
If nEstrTotArcVir > 0 Then
If bPrimaEstrFissa Then
nMoltiplicatore =(nEstrTotArcVir - 1) Mod 90
Else
nMoltiplicatore = nEstrTotArcVir Mod 90
End If
Else
nMoltiplicatore = 0
End If
For idEstr = idPrimaEstrToAddArchVirt To idUltimaEstr
ReDim aNumA(11,5)
If idEstr = idPrimaEstr Then
If bPrimaEstrFissa = False Then
nMoltiplicatore = 1
End If
Else
nMoltiplicatore = nMoltiplicatore + 1
End If
If nMoltiplicatore = 90 Then
For r = 1 To 11
For e = 1 To 5
aNumA(r,e) = Estratto(idEstr,Iif(r = 11,12,r),e)
Next
Next
nMoltiplicatore = 0
Else
For r = 1 To 11
If Estratto(idEstr,Iif(r = 11,12,r),1) > 0 Then
For e = 1 To 5
If i <= 12 Then
aNumA(r,e) = DiffCiclometrica(Estratto(idEstr,Iif(r = 11,12,r),e),Fuori90(nBase * nMoltiplicatore))
ElseIf i > 12 And i <= 24 Then
nBaseTmp = ComplAdX (nBase)
aNumA(r,e) = Fuori90(Estratto(idEstr,r,e) + Fuori90(nBaseTmp * nMoltiplicatore))
Else
aNumA(r,e) = Estratto(idEstr,Iif(r = 11,12,r),e)
End If
Next
End If
Next
End If
sData = DataEstrazione(idEstr,,,"/")
Call SalvaEstrazione(aNumA,sData,IndiceAnnuale(idEstr),sFile)
Messaggio "Archivio virtuale " & nBase & " estr . " & idEstr
If ScriptInterrotto Then Exit For
Next
If ScriptInterrotto Then Exit For
Else
MsgBox "Errore non previsto , rigenerare gli archivi daccapo per risolvere il problema"
End If
Call AvanzamentoElab(1,UBound(aNumPrimi),i)
Next
End Sub
Sub AlimentaPrimi(ANumPrimi)
ReDim ANumPrimi(25)
ANumPrimi(1) = 1
ANumPrimi(2) = 7
ANumPrimi(3) = 11
ANumPrimi(4) = 13
ANumPrimi(5) = 17
ANumPrimi(6) = 19
ANumPrimi(7) = 23
ANumPrimi(8) = 29
ANumPrimi(9) = 31
ANumPrimi(10) = 37
ANumPrimi(11) = 41
ANumPrimi(12) = 43
ANumPrimi(13) = 90 - 1
ANumPrimi(14) = 90 - 7
ANumPrimi(15) = 90 - 11
ANumPrimi(16) = 90 - 13
ANumPrimi(17) = 90 - 17
ANumPrimi(18) = 90 - 19
ANumPrimi(19) = 90 - 23
ANumPrimi(20) = 90 - 29
ANumPrimi(21) = 90 - 31
ANumPrimi(22) = 90 - 37
ANumPrimi(23) = 90 - 41
ANumPrimi(24) = 90 - 43
ANumPrimi(25) = 90
End Sub
Function GetNomeFileArchVirt(sDirArchivi, nBase, bPrimaEstrFissa, nPrimaEstr)
If bPrimaEstrFissa Then
GetNomeFileArchVirt = sDirArchivi & "SVP D(" & nBase & ") ConFissi [" & nPrimaEstr & "].dat"
Else
GetNomeFileArchVirt = sDirArchivi & "SVP D(" & nBase & ") NoFissi [" & nPrimaEstr & "].dat"
End If
End Function
Function GetDataEstrArchivioVirt(sFile,idEstr)
Dim sData
Call LeggiEstrazioneDaFile(sFile,idEstr,sData,0,"")
GetDataEstrArchivioVirt = sData
End Function
Sub GeneraFileCsv(sDir,aNumPrimi,bPrimaFissa ,nPrimaEstr)
Dim sFileCsv,sFileArcVirt,nBase,k,idEstr,sEstr,sData,nIndice,r,e,sChrSep
Dim nEstrProdotte
sChrSep = ";"
nEstrProdotte = 0
For k = 1 To UBound(aNumPrimi)
nBase = aNumPrimi(k)
sFileArcVirt = GetNomeFileArchVirt(sDir,nBase,bPrimaFissa,nPrimaEstr)
sFileCsv = sFileArcVirt & ".csv"
Call EliminaFile(sFileCsv)
sEstr = "Indice" & sChrSep & "Data" & sChrSep
For r = 1 To 11
For e = 1 To 5
sEstr = sEstr & SiglaRuota(Iif(r = 11,12,r)) & sChrSep
Next
Next
sEstr = RimuoviLastChr(sEstr,sChrSep)
Call ScriviFile(sFileCsv,sEstr,True,True)
Call Messaggio("Creazione file csv archivio base : " & nBase)
For idEstr = 1 To QuantitaEstrazioniInFile(sFileArcVirt)
ReDim aNum(12,5)
Call LeggiEstrazioneDaFile(sFileArcVirt,idEstr,sData,nIndice,aNum)
sEstr = nIndice & sChrSep & sData & sChrSep
For r = 1 To 12
If r <> 11 Then
For e = 1 To 5
sEstr = sEstr & Format2(aNum(r,e)) & sChrSep
Next
End If
Next
sEstr = RimuoviLastChr(sEstr,sChrSep)
Call ScriviFile(sFileCsv,sEstr,False,True)
nEstrProdotte = nEstrProdotte + 1
If ScriptInterrotto Then Exit For
Next
Call CloseAllFileHandle
Call AvanzamentoElab(1,UBound(aNumPrimi),k)
If ScriptInterrotto Then Exit For
Next
If nEstrProdotte > 0 Then
MsgBox "I file csv sono presenti nella directory " & vbCrLf & sDir
Call ApriDirectory(sDir)
End If
End Sub
