Function setfields()
With abfrage2
Me.txtPerNr = .r!PerNr
Me.txtname = .r!PerName
Me.txtvorname = .r!PerVorname
Me.txtlart = .r!LArt
Me.txtarbplatz = .r!PerArbPlatz
Me.Mitarbeiterauswahl.Value = .r!PerNr
End With
 
If Me.Datumauswahl.ListCount > 0 Then
i = 0
j = Me.Datumauswahl.ListCount - 1
Do Until i > j
    Me.Datumauswahl.RemoveItem (j - i)
    i = i + 1
Loop
End If
 
Set abfrage3 = Nothing 'Hier hab ich es nun eingebaut abfrage3.r = Nothing 
' hilft leider auch nicht
 
With abfrage3
.dbname = "ZeitRM.mdb"
.queryname = "SELECT Erfassung.EPerNr, Erfassung.EKom, Erfassung.EGeh," & _
  "Erfassung.EIstAZeit, " & _
"Sum(Belegung.IstArbeit) AS SumIstArbeit, Erfassung.EVol, Belegung.Erled," & _
"Belegung.PMVor, " & _
"Erfassung.EDatum, Erfassung.ESAP FROM Erfassung LEFT JOIN Belegung ON (" & _
"Erfassung.EPerNr = Belegung.PerNr) " & _
"WHERE Erfassung.EPerNr = " & Me.txtPerNr & _
"AND (Erfassung.EDatum = Belegung.BDatum) GROUP BY Erfassung.EPerNr," & _
"Erfassung.EKom, Erfassung.EGeh, " & _
"Erfassung.EIstAZeit, Erfassung.EVol, Belegung.Erled, Belegung.PMVor," & _
"Erfassung.EDatum, Erfassung.ESAP " & _
"HAVING Erfassung.ESAP Like 'F' ORDER BY Erfassung.EDatum"
.query
If .r.EOF = False Then
    Do Until .r.EOF = True
        Debug.Print .r.AbsolutePosition
        Me.Datumauswahl.AddItem .r![EDatum] & ";" & .r![EKom] & ";" & .r![EGeh] _
          & ";" & .r![EIstAZeit] & ";" & .r![SumIstArbeit]
        .r.MoveNext
    Loop
    .r.MoveFirst
End If
End With
End Function