Sto provando da un po'di giorni a questa parte a creare questo programma che stranamente per 2-3 volte ha funzionato a dovere, ma non ricordo che impostazioni avevo dato e quindi ciccia... Le sto provando tutte ma ora mi si blocca quasi sempre in : "While Seek(1) < LOF(1) " mi è stato detto di cambiarlo con "While Not (EOF(1)) " ma il problema persiste, qui di seguito vi posto il codice spero possiate aiutarmi...
P.S. : Alla fine vi scrivo cosa dovrebbe leggere e cosa dovrebbe uscire
P.P.S. : Ultimamente sono riuscito a fargli leggere il primo record riscriverlo come voglio io ma poi si pianta.
codice:
Private Risulta() As Variant
____________________________________________________________________
Private Function Totale()
Line1:
ReDim Risulta(0) As Variant
Dim k As Integer
k = lblristot.Caption
'a = lblblocchi.Caption
On Error GoTo GestoreErrori
Open CommonDialog1.FileName For Input As #1
Seek #1, 1
'Inizio
Inizio = 1
lblblocchi.Caption = LOF(1)
'lblbloctot.Caption = "/ " & LOF(1)
While lblblocchi.Caption = 1876 'Not (EOF(1))
DoEvents
lblbloctot.Caption = k ' Seek(1)
txtDati.Text = ""
Par = 0
Prima = 0
While Par = 0
Car = Input$(1, #1)
Seek #1, (Seek(1) - 1)
If Car = "[" Then
Test = Input$(1, #1)
Seek #1, (Seek(1) - 1)
If (Test = "[") Then
If Prima = 0 Then
txtDati.Text = txtDati.Text & Input$(1, #1)
Prima = 1
Else
Par = 1
Seek #1, (Seek(1) - 1)
End If
Else
GoTo Line2
End If
Else
Line2:
txtDati.Text = txtDati.Text & Input$(1, #1)
End If
Wend
Dati = txtDati.Text
Apre = InStr(Dati, "[")
Chiude = InStr(Dati, "]")
Trova = Mid(Dati, (Apre + 1), (Chiude - Apre - 1))
If InStr(Trova, "") Then
txtWorld.Text = Trova
Codice = Mid(Trova, 5, Len(Trova))
If Trova = "EOF" Then
txtLista.Text = txtLista.Text & vbCrLf & "[EOF]"
MsgBox "Finito!", vbOKOnly, "Lavoro Finito!"
'GoTo Line3
End If
'Codice = Mid(Trova, 5, Len(Trova))
'lt = 0
'ok = 0
'Do While (lt < 1)
'If Codice = (lt) Then
'ok = 1
'End If
'lt = lt + 1
'Loop
mioval = Ricerca("[")
mioval1 = Ricerca("NAME=")
mioval2 = Ricerca("ID=")
mioval3 = Ricerca("COLOR=")
mioval4 = Ricerca("CATEGORY=")
mioval5 = Ricerca("SUBSECTION=")
mioval6 = Ricerca("DESCRIPTION=")
If (k = 0) Then
Risulta(k) = mioval
txtLista.Text = txtLista.Text & vbCrLf & "[" & mioval & vbCrLf & "NAME=" & mioval1 & vbCrLf & "ID=" & mioval2 & vbCrLf & "COLOR=" & mioval3 & vbCrLf & "CATEGORY=" & mioval4 & vbCrLf & "SUBSECTION=" & mioval5 & vbCrLf & "DESCRIPTION=" & mioval6 & vbCrLf
k = k + 1
Else
ReDim Preserve Risulta(k + 1)
Risulta(k + 1) = mioval
txtLista.Text = txtLista.Text & vbCrLf & "[" & mioval & vbCrLf & "NAME=" & mioval1 & vbCrLf & "ID=" & mioval2 & vbCrLf & "COLOR=" & mioval3 & vbCrLf & "CATEGORY=" & mioval4 & vbCrLf & "SUBSECTION=" & mioval5 & vbCrLf & "DESCRIPTION=" & mioval6 & vbCrLf
k = k + 1
End If
' mioval = Ricerca("[")
' mioval1 = Ricerca("NAME=")
' mioval2 = Ricerca("ID=")
' mioval3 = Ricerca("COLOR=")
' mioval4 = Ricerca("CATEGORY=")
' mioval5 = Ricerca("SUBSECTION=")
' mioval6 = Ricerca("DESCRIPTION=")
' txtLista.Text = txtLista.Text & vbCrLf & "[" & mioval & vbCrLf & "NAME=" & mioval1 & vbCrLf & "ID=" & mioval2 & vbCrLf & "COLOR=" & mioval3 & vbCrLf & "CATEGORY=" & mioval4 & vbCrLf & "SUBSECTION=" & mioval5 & vbCrLf & "DESCRIPTION=" & mioval6 & vbCrLf
Par = 0
Inizio = 0
Close #1
GestoreErrori:
MsgBox "Errore", vbOKOnly, "Riguardalo!!!"
End If
Wend
End Function
Scusatemi per tutti i commenti che ho messo ma sapete per testarlo
codice:
come è come deve diventare
[55ac] [55ac]
NAME=Lizard Hides NAME=Lizard Hides
ID=1078 ID=1078
WEIGHT=3 COLOR=030f
COLOR=030f CATEGORY=Prova
DEF=LIZARD_HIDE SUBSECTION=Pippo
CATEGORY=Prova DESCRIPTION=Pluto
SUBSECTION=Pippo
DESCRIPTION=Pluto
Aspetto vostre risposte
tnx GM Pestilence