Dim contador As Integer
Dim azar As Integer
Dim azar1 As Integer
Dim azar2 As Integer
Dim azar3 As Integer
Dim azar4 As Integer

Private Sub Command1_Click()
'Nuevo
Text6.Text = contador + 1
contador = contador + 1
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""


End Sub

Private Sub Command2_Click()

'Guardar

    Open App.Path & "\azar" & ".txt" For Append As #1
    Print #1, Text6.Text & vbCrLf
    Print #1, Text1.Text, Text2.Text, Text3.Text, Text4.Text, Text5.Text & vbCrLf
    Close #1


End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Command5_Click()
' Calcular

Randomize
azar = Int(Rnd * 45) + 1
Text1.Text = azar
azar1 = Int(Rnd * 45) + 1
Text2.Text = azar1
azar2 = Int(Rnd * 45) + 1
Text3.Text = azar2
azar3 = Int(Rnd * 45) + 1
Text4.Text = azar3
azar4 = Int(Rnd * 45) + 1
Text5.Text = azar4
End Sub

Private Sub Form_Load()
If contador = 0 Then
Open App.Path & "\azar" & ".txt" For Append As #1
Close #1
End If
If contador = 0 Then contador = 1
Open App.Path & "\azar" & ".txt" For Input As #1
     While Not EOF(1)
     Input #1, contador
     Input #1, azar, azar1, azar2, azar3, azar4

en el segunda lectura me pone el siguiente error:
Error '62' en tiempo de ejecucion:
la entrada de datos se ha sobrepasado el final del archivo


     Wend
      Close #1
Text6.Text = contador
End Sub

Private Sub Form_Load()
List1.AddItem "jorge" & "               " & "Ramirez"
List1.AddItem "luis" & "                " & "Rodriguez"
List1.AddItem "pedro" & "               " & "Gonzalez"

End Sub



Private Sub List1_DblClick()

'Form2.Text1.Text = List1.List(List1.ListIndex)

Dim i As Integer

 Form2.Text1.Text = Mid(List1.Text, 1, InStr(1, List1.Text, " ") - 1)
Form2.Text2.Text = Mid(List1.Text, InStr(List1.Text, " ") + 16)
i = List1.ListIndex
   

Form2.Show
End Sub

Private Sub Command1_Click()
 Form1.List1.List(Form1.List1.ListIndex) = Form2.Text1.Text
Form1.List1.List(Form1.List1.ListIndex) = Form2.Text2.Text
Unload Me
End Sub

Option Explicit
Dim g As Integer
Dim i As Integer
Dim fencontrada As Boolean

Private Sub Combo1_Click()
 Dim f_Canal As Long
On Error GoTo plo
fencontrada = False
List1.Clear
Select Case Combo1.Text
Case "enero":
g = 0
Call BuscarItems(List1.List(List1.ListIndex))

Case "febrero":
g = 1
Call BuscarItems(List1.List(List1.ListIndex))


Case "marzo":
g = 2
Call BuscarItems(List1.List(List1.ListIndex))


Case "abril":
g = 3
Call BuscarItems(List1.List(List1.ListIndex))


Case "mayo":
g = 4
Call BuscarItems(List1.List(List1.ListIndex))

Case "junio":
g = 5
Call BuscarItems(List1.List(List1.ListIndex))



Case "julio":
g = 6
Call BuscarItems(List1.List(List1.ListIndex))


Case "agosto":
g = 7
Call BuscarItems(List1.List(List1.ListIndex))


Case "septiembre":
g = 8
Call BuscarItems(List1.List(List1.ListIndex))

Case "octubre":
g = 9
Call BuscarItems(List1.List(List1.ListIndex))



Case "noviembre":
g = 10
Call BuscarItems(List1.List(List1.ListIndex))


Case "diciembre":
g = 11
Call BuscarItems(List1.List(List1.ListIndex))



End Select



plo:
If Not fencontrada Then
    MsgBox "El Mes " & Combo1.Text & " no existe."
    Combo1.Text = ""
   Close f_Canal

End If
End Sub



Private Sub Form_Load()
Combo1.Clear
Combo1.AddItem "enero"
Combo1.AddItem "febrero"
Combo1.AddItem "marzo"
Combo1.AddItem "abril"
Combo1.AddItem "mayo"
Combo1.AddItem "junio"
Combo1.AddItem "julio"
Combo1.AddItem "agosto"
Combo1.AddItem "septiembre"
Combo1.AddItem "octubre"
Combo1.AddItem "noviembre"
Combo1.AddItem "diciembre"
End Sub


Private Sub BuscarItems(ByVal strFecha As String)
    Dim item As String
 Dim f_Canal As Long
   
 
    With file
        Text1.Text = CStr(.Id)
        Text2.Text = CStr(.Date)
        Text3.Text = CStr(.Name)
    End With
 Open App.Path & "\database.txt" For Random As f_Canal Len = Len(file)
    Seek (f_Canal), 1     ' posicionar el puntero de lectura al comienzo del fichero (en vb6 es la dirección 1).
    Do While Not EOF(f_Canal)
        Get f_Canal, , file
        With file
            If (StrComp(strFecha, CStr(.date), vbTextCompare) = 0) Then
                item = FormatStr(CStr(.id), 4, True)
                item = FormatStr(item, 12) & _
                       FormatStr(CStr(.date), 16) & _
                       FormatStr(.name, 40)
            Call List1.AddItem(item)
            End If
        End With
    Loop
    Close f_Canal
End Sub

Private Function FormatStr(ByRef Txt As String, ByVal Limite As Integer, Optional ByVal EsNumero As Boolean = False)

    If EsNumero Then
        FormatStr = FormatNumber(Txt, Limite)
    Else
        FormatStr = FormatString(Txt, Limite)
    End If
End Function
 
' Asegura que el texto tenga por tamaño exactamente el valor de límite
' Si es más corto añade espacios a la derecha.
Private Function FormatString(ByRef Txt As String, ByVal Limite As Integer) As String
    Dim k As Integer
 Dim maximo As Integer
    k = Len(Txt)
    k = (Limite - k)
    If (k > 0) Then
        FormatString = Txt & Space$(k)
    ElseIf (k < 0) Then
        FormatString = Left$(Txt, maximo)
    Else
        FormatString = Txt
    End If
End Function
 
 'Asegura que el texto tenga por tamaño exactamente el valor de límite
' OJO: Si es más corto añade 'ceros' a la izquierda.
Private Function FormatNumber(ByRef Txt As String, ByVal Limite As Integer) As String
    Dim k As Integer
 
    k = Len(Txt)
    k = (Limite - k)
    If (k > 0) Then
       FormatNumber = String$(k, "0") & Txt
    ElseIf (k < 0) Then
        FormatNumber = Left$(Txt, Limite)
Else
        FormatNumber = Txt
    End If
End Function



y en un modulo:

Type Task
id As Integer
date As Date
name As String * 30
End Type


Option Explicit
Global file As Task

Option Explicit
Dim n As Integer



Private Sub Command1_Click()
'Nuevo
Open App.Path & "\database.txt" For Random As 1 Len = Len(file)


n = LOF(1) / Len(file)

Get #1, n, file
Text1.Text = n + 1
Close #1

Text2.Text = Format(date, "dd/mm/yyyy")
Text3.Text = ""
Text3.SetFocus
End Sub

Private Sub Command2_Click()
'Guardar
file.id = Text1.Text
file.date = Text2.Text
file.name = Text3.Text

Open App.Path & "\database.txt" For Random As 1 Len = Len(file)

n = LOF(1) / Len(file)
Put #1, n + 1, file
Close #1
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Command4_Click()
Unload Me
Form2.Show
End Sub

Private Sub Form_Load()
Open App.Path & "\database.txt" For Random As 1 Len = Len(file)

n = LOF(1) / Len(file)

Get #1, n, file
Text1.Text = n + 1

Close #1

Text2.Text = Format(date, "dd/mm/yyyy")
End Sub

Type Task
id As Integer
date As Date
name As String * 30
End Type


Option Explicit
Global file As Task

en un modulo:


Type Task
id As Integer
date As Date
name As String * 30
End Type


Option Explicit
Global file As Task



en el formulario






Private f_Canal     As Integer     ' canal del fichero.

Private Sub List1_Click()
    Call BuscarItems(lisFechas.List(lisFechas.ListIndex))
End Sub
 
' Qué buscamos?: El dato (fecha), que se ha pulsado en list1...
'  y lo buscamos en todos los registros del fichero.
Private Sub BuscarItems(ByVal strFecha As String)
    Dim item As String
 
    List2.Clear
    Open App.Path & "\database.txt" For Random As f_canal Len = Len(file)
 
    Seek (f_Canal), 1     ' posicionar el puntero de lectura al comienzo del fichero (en vb6 es la dirección 1).
    Do While Not EOF(f_Canal)
        Get f_Canal, , file
        With file
            If (StrComp(strFecha, CStr(.Date), vbTextCompare) = 0) Then
                item = FormatStr(CStr(.Id), 6, True)
                item = FormatStr(item, 12) & _
                       FormatStr(CStr(.Date), 16) & _
                       FormatStr(.Name, 44)
                Call List2.AddItem(item)  ' list2, probablemente no precise estar ordenado...
            End If
        End With
    Loop

Close #f_canal
End Sub

Option Explicit
Dim n As Integer
Dim c As Integer


Private Sub Command1_Click()
Unload Me
Form1.Show
End Sub


Private Sub Form_Load()
List1.Clear
Open App.Path & "\database.txt" For Random As 1 Len = Len(file)
n = LOF(1) / Len(file)
c = 1
For c = 1 To n


Get #1, , file

List1.AddItem file.date
QuitaDup
Next
Close #1
End Sub
Private Sub QuitaDup()
  Dim i As Long, X As Long
  X = List1.ListCount - 1
  For i = 0 To List1.ListCount - 2
    If List1.List(i) = List1.List(X) Then
     
      List1.RemoveItem X
     
      Exit For
    End If
  Next i
End Sub

Private Sub List1_Click()
Dim i As Integer
Dim ind As Integer
List2.Clear
Form1.Text1.Text = file.id
Form1.Text2.Text = file.date
Form1.Text3.Text = file.name
ind = List1.ListIndex
Open App.Path & "\database.txt" For Random As 1 Len = Len(file)
n = LOF(1) / Len(file)
For i = 0 To List1.ListCount + 1
If ind <= 0 Then
Get #1, i + 1, file

List2.AddItem file.id & "         " & file.date & "          " & file.name
End If
Next
Close #1
End Sub

Dim i As Integer
mes = Text8.Text
fecha = Text1.Text
nombre = Text2.Text
apellido = Text3.Text
producto = Text4.Text
cantidad = Text5.Text
precio = Text6.Text
total = Val(Text5.Text) * Val(Text6.Text)
Text7.Text = Val(Text5.Text) * Val(Text6.Text)
archivo = App.Path & "\ventas.txt"
Open archivo For Append As #1
Write #1, mes, fecha, nombre, apellido, producto, cantidad, precio, total
For i = 0 To List1.ListCount - 1

        Print #1, List1.List(i)
        Next i
Close #1

dim gh as string
gh = App.Path & "\facturas" & "\" & Prefix_Facturas & Text3.Text & ".TXT"
        Open gh For Random As #1 Len = Len(datos)
        Get #1, (List1.ListIndex + 1), datos
        Text7.Text = datos.producto
        Text8.Text = datos.precio
        Text9.Text = datos.existencias
        Text10.Text = datos.subtotal
        Close #1

'DEFININMOS LOS ELEMENTOS DE LA FACTURA
Private Type Type_Articulos_Factura
    codigo_articulo As String
    nombre_articulo As String
    precio_articulo As String
End Type

Private Type Type_Datos_Factura
    Codigo_Factura As String
    Nombre_Cliente_Factura As String
    Fecha_Factura As String
    Articulos_Factura() As Type_Articulos_Factura
End Type
Dim factura As Type_Datos_Factura

Private Type Type_Indices
    Codigo_Facturas As Integer
    Codigo_Albaranes As Integer
End Type

Dim detalle As Integer
Const Prefix_Facturas = "Fact"  'Asignamos un prefijo a las facturas para cuandos se guarden
Private Indices As Type_Indices

Private Sub Agregar_Articulo(nombre_articulo, codigo_articulo, precio_articulo)
List1.AddItem nombre_articulo & Space(14) & codigo_articulo & Space(27) & precio_articulo
    factura.Articulos_Factura(UBound(factura.Articulos_Factura)).codigo_articulo = codigo_articulo
    factura.Articulos_Factura(UBound(factura.Articulos_Factura)).nombre_articulo = nombre_articulo
    factura.Articulos_Factura(UBound(factura.Articulos_Factura)).precio_articulo = precio_articulo
     ReDim Preserve factura.Articulos_Factura(0 To UBound(factura.Articulos_Factura) + 1)
End Sub

Private Sub Crear_Factura(Codigo_Factura, Nombre_Cliente, Fecha_Factura)
    factura.Codigo_Factura = Codigo_Factura
    factura.Nombre_Cliente_Factura = Nombre_Cliente
    factura.Fecha_Factura = Fecha_Factura
    ReDim Preserve factura.Articulos_Factura(0 To 0)
End Sub


Private Sub Command1_Click()
'Nueva Factura
Text4.SetFocus
 List1.Clear
    Indices.Codigo_Facturas = Indices.Codigo_Facturas + 1
    Label1.Caption = Indices.Codigo_Facturas
    'GUARDAMOS EL CODIGO DE LA NUEVA FACTURA
    Open App.Path & "\Indices.txt" For Binary As #1
    Put #1, , Indices
    Close #1
    Label4.Caption = "Factura:"
   Text1.Text = "Pedro"
   Text2.Text = Date
    Crear_Factura Indices.Codigo_Facturas, Text1.Text, Text2.Text

    
    'Iniciamos la nueva Factura
    
    Command5.Enabled = True
    Command6.Enabled = True
    
    
    
End Sub

Private Sub Command2_Click()
   End
    
End Sub


Private Sub GUARDAR_FACTURA()
factura.Nombre_Cliente_Factura = Text1.Text
factura.Fecha_Factura = Text2.Text


     Open App.Path & "\" & Prefix_Facturas & Indices.Codigo_Facturas & ".TXT" For Binary As #1
     Put #1, , factura
     Close #1
     
     
End Sub

Private Sub Command3_Click()
' modificar datos
If List1.ListIndex < 0 Then
MsgBox "Ningún elemento ha sido seleccionado", vbInformation
Exit Sub
End If



List1.AddItem Text4.Text & Space(14) & Text5.Text & Space(27) & Text6.Text
List1.RemoveItem List1.ListIndex


GUARDAR_FACTURA

Call Command7_Click


End Sub

Private Sub Command5_Click()
GUARDAR_FACTURA
End Sub

Private Sub Command6_Click()
' Agregar articulo al list1
  Agregar_Articulo Text4.Text, Text5.Text, Text6.Text
End Sub

Private Sub Command7_Click()
'leer los datos de la factura
Dim gh As String, lp As String

Text1.Text = ""
Text2.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
List1.Clear
On Error GoTo err:

 If Len(Dir(gh)) <> 0 Then
gh = App.Path & "\" & Prefix_Facturas & Text3.Text & ".TXT"
    Open gh For Binary Access Read Lock Read As #1
    
     Get #1, , factura
    
     Close #1
     Label1.Caption = factura.Codigo_Factura
     Text1.Text = factura.Nombre_Cliente_Factura
     Text2.Text = factura.Fecha_Factura
    
     For total_articulos = 0 To UBound(factura.Articulos_Factura) - 1
     nombre_articulo = factura.Articulos_Factura(total_articulos).nombre_articulo
      codigo_articulo = factura.Articulos_Factura(total_articulos).codigo_articulo
       precio_articulo = factura.Articulos_Factura(total_articulos).precio_articulo
     List1.AddItem nombre_articulo & Space(12) & codigo_articulo & Space(31) & precio_articulo
      
     Next
     
     End If
     
     Exit Sub
err:
MsgBox "Factura no Existe", vbCritical, "ERROR"
Kill gh
End Sub

Private Sub Form_Load()
' leer el numero de la ultima factura
Open App.Path & "\Indices.txt" For Binary As #1
    Get #1, , Indices
    Close #1
 Label1.Caption = Indices.Codigo_Facturas
Command1.Enabled = True
Command5.Enabled = True
End Sub

Private Sub List1_Click()
' leer los datos del list1 a text4.text, text5.text, text6.text
Dim gh As String
Dim total_articulos As Integer
If List1.ListIndex < 0 Then
MsgBox "Ningún elemento ha sido seleccionado", vbInformation
Exit Sub
End If


gh = App.Path & "\" & Prefix_Facturas & Text3.Text & ".TXT"
    Open gh For Binary Access Read Lock Read As #1
    
     Get #1, , factura
      For total_articulos = 0 To List1.ListIndex
   
     Text4.Text = factura.Articulos_Factura(total_articulos).nombre_articulo
     Text5.Text = factura.Articulos_Factura(total_articulos).codigo_articulo
     Text6.Text = factura.Articulos_Factura(total_articulos).precio_articulo
     Next
 
     Close #1

End Sub

Este formulario es el de grabar datos lo hace perfecto.

Dim fecha As String
Dim nombre As String
Dim apellido As String
Dim producto As String
Dim cantidad As Integer
Dim precio As Integer
Dim total As Integer
Dim archivo As String

Private Sub Command1_Click()
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text2.SetFocus
End Sub

Private Sub Command2_Click()
Dim i As Integer
fecha = Text1.Text
nombre = Text2.Text
apellido = Text3.Text
producto = Text4.Text
cantidad = Text5.Text
precio = Text6.Text
total = Val(Text5.Text) * Val(Text6.Text)
Text7.Text = Val(Text5.Text) * Val(Text6.Text)
archivo = App.Path & "\ventas.txt"
Open archivo For Append As #1
Write #1, fecha, nombre, apellido, producto, cantidad, precio, total
For i = 0 To List1.ListCount - 1

        Print #1, List1.List(i)
        Next i
Close #1

End Sub



Este formulario es el de consula

Dim fe As String
Dim nom As String
Dim apel As String
Dim prod As String
Dim cant As Integer
Dim prec As Integer
Dim tot As Integer
Dim archivo As String
Private Sub Command1_Click()
Unload Me
Form1.Show
End Sub
Private Sub Command2_Click()
Text1.Text = ""
List1.Clear
Text1.SetFocus
End Sub


Private Sub Command3_Click()
List1.Clear
List2.Clear
Dim k As Integer
If Text1.Text = "" Then Exit Sub
fe = Format(Text1.Text, Date)
Text1.Text = fe
Text2.Text = nom
Text3.Text = apel
Text4.Text = prod
Text5.Text = cant
Text6.Text = prec
Text7.Text = tot
archivo = App.Path & "\ventas.txt"
Open archivo For Input As #1
If fe = Date Then
While Not EOF(1)
Input #1, fe, nom, apel, prod, cant, prec, tot
List1.AddItem fe & "        " & nom & "       " & apel & "      " & prod & "       " & cant & "      " & prec & "        " & tot

Wend
End If
Close #1

End Sub