Private tmpSaveString As String
Private tmpName As String
Private tmpGroesse As Long
Private tmpFigur As Long
Private tmpStatus As Long
 
Public Event BevoreAppend(ByVal sName As String)
Public Event AfterAppend(ByVal sName As String)
Public Event AppendError(ByVal nNum As Long, ByVal Description As String)
 
Public Property Get SaveString() As String
   tmpSaveString = tmpName & "/" & CStr(tmpFigur) & _
                "/" & CStr(tmpGroesse) & "/" & _
                CStr(tmpStatus)
   SaveString = tmpSaveString
End Property
 
Public Property Let LoadString(ByVal sFileDS As String)
    Dim vErg As Variant
 
    'On Error Resume Next
    vErg = Split(sFileDS, "/")
    tmpName = vErg(0)
    tmpFigur = vErg(1)
    tmpGroesse = vErg(2)
    tmpStatus = vErg(3)
End Property
 
Public Function AppendToFile(ByVal sFileName As String) As Long
    Dim f As Integer
    f = FreeFile
    RaiseEvent BevoreAppend(Name)
    On Error Resume Next
    Open sFileName For Append As #f
    If Err.Number > 0 Or f = 0 Then
        RaiseEvent AppendError(Err.Number, Err.Description)
        Exit Function
    End If
    Print #f, tmpSaveString
    Close #f
    RaiseEvent AfterAppend(Name)
    AppendToFile = 1
End Function
 
Public Property Get Name() As String
   Name = tmpName
End Property
 
Public Property Let Name(ByVal vNewValue As String)
   tmpName = vNewValue
End Property
 
Public Property Get Groesse() As Long
   Groesse = tmpGroesse
End Property
 
Public Property Let Groesse(ByVal vNewValue As Long)
   tmpGroesse = vNewValue
End Property
 
Public Property Get Figur() As Long
   Figur = tmpFigur
End Property
 
Public Property Let Figur(ByVal vNewValue As Long)
   tmpFigur = vNewValue
End Property
 
Public Property Get Status() As Long
   Status = tmpStatus
End Property
 
Public Property Let Status(ByVal vNewValue As Long)
   tmpStatus = vNewValue
End Property

Private myCol As New Collection
Private WithEvents myPer As clsPerson
 
Private Sub Form_Load()
   Dim f As Integer
   Dim sSatz As String
 
   'Zu Testzwecken wird eine Datei gefüllt
   On Error Resume Next
   Kill "C:\Test.TXT"
   Set myPer = New clsPerson
   With myPer
      .Name = "Hans Müller"
      .Figur = 1
      .Groesse = 3
      .Status = 2
      sSatz = .SaveString
      .AppendToFile ("C:\Test.TXT")
      .Name = "Franz Testheimer"
      .Figur = 2
      .Groesse = 1
      .Status = 3
      sSatz = .SaveString
      .AppendToFile ("C:\Test.Txt")
      .Name = "Waldemar Lordchen"
      .Figur = 1
      .Groesse = 2
      .Status = 1
      sSatz = .SaveString
      .AppendToFile ("C:\Test.TXT")
   End With
 
   ' Datei auslesen
   f = FreeFile
   Open "C:\Test.TXT" For Input As #f
   Do While Not EOF(f)
      Line Input #f, sSatz
      Set myPer = New clsPerson
      myPer.LoadString = sSatz
      List1.AddItem myPer.Name
      myCol.Add myPer, myPer.Name
   Loop
   Close #f
   With Combo1
     .AddItem "Egal"
     .AddItem "Wichtig"
     .AddItem "Sehr Wichtig"
     .AddItem "Göttlich"
   End With
   With Combo2
     .AddItem "Schlank"
     .AddItem "Etwas beleibt"
     .AddItem "Dick"
   End With
   With Combo3
     .AddItem "Klein"
     .AddItem "Mittel"
     .AddItem "Groß"
   End With
   List1.ListIndex = 0
End Sub
 
Private Sub List1_Click()
   Combo1.ListIndex = myCol(List1.List(List1.ListIndex)).Status - 1
   Combo2.ListIndex = myCol(List1.List(List1.ListIndex)).Figur - 1
   Combo3.ListIndex = myCol(List1.List(List1.ListIndex)).Groesse - 1
End Sub
 
Private Sub myPer_AppendError(ByVal nNum As Long, ByVal Description As String)
   MsgBox "Fehler bei: " + Description
End Sub