Option Compare Database
 
Public r As Recordset
Private WS As Workspace
Private DB As database
Private SysMdwFileName As String
Private DBFileName As String
Private strquery As String
 
Property Let queryname(querystr As String)
    strquery = querystr
End Property
 
Property Let dbname(dbdata As String)
    DBFileName = "H:\.............." & dbdata
End Property
 
Function query()
    SysMdwFileName = "H:\.....................MDW"
 
    'DBEngine mitteilen, wo die System.mdw liegt
    DBEngine.SystemDB = SysMdwFileName
 
    'Workspace mit dem Namen "MyWs" für User "..............." mit Passwort 
    ' "..........." erzeugen
    Set WS = DBEngine.CreateWorkspace("Zeiterfassung", ".....", ".........", _
      dbUseJet)
 
    'und dann die DB öffnen
    Set DB = WS.OpenDatabase(DBFileName, False)
 
    Set r = DB.OpenRecordset(strquery, dbOpenDynaset)
End Function

Dim abfrage2 As New tablequery
Dim abfrage3 As New tablequery

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
 
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