Option Explicit
Dim rech As ADODB.Recordset
Dim artikel As ADODB.Recordset
Dim stamm As ADODB.Recordset
Dim oRs As Recordset
Dim oConn As New Connection
Dim msg, msg1, Jahr, auswahl
Dim ar_rs As ADODB.Recordset
Dim kdSuchen_rs As ADODB.Recordset
Dim art_rs As ADODB.Recordset
Dim WithEvents f1 As StdDataFormat
Dim Abfrage, SQLAbfrage, txtbind, SQL As String
Public vorJahr, vorJahr1, vorjahr2, vorjahr3, MAuswahl
Public suchen, getArtFind, SQL2 As Boolean
-------------------------------
Private Sub cmd_archiv_Click()
With oConn
    ' Provider: Access 2000/XP
    .Provider = "Microsoft.Jet.OLEDB.4.0"
 
    ' Pfad zur Access-Datenbank
    .Properties("Data Source") = "\\server\faktura\faktura\datenbank\archiv.mdb"
 
    ' Cursor-Location
    .CursorLocation = adUseClient
 
    ' Connection öffnen
    .Open
 
    ' Recordset über Tabellen-Schema erstellen
    Set oRs = .OpenSchema(adSchemaTables)
 
    ' Recordset durchlaufen und alle Tabellen auflisten
 
    Do Until oRs.EOF
      If oRs("TABLE_TYPE") = "TABLE" Then
        Combo1.AddItem oRs("TABLE_NAME")
      End If
      oRs.MoveNext
    Loop
  End With
 
  ' Recordset und Connection schließen
  Combo1.ListIndex = 1
  oRs.Close
  oConn.Close
fra_aktuell.Visible = False
fra_archiv.Enabled = True: Picture1.Visible = False: fra_archiv.Visible = True
End Sub
----------------------------------
Private Sub cmd_auswahl_Click()
aktualisieren (Text20.text)
End Sub
 
Private Sub cmd_hinzu_Click()
fra_archiv.Visible = False
fra_aktuell.Enabled = True: Picture1.Visible = False: fra_aktuell.Visible = True
Text20.SetFocus
End Sub
--------------------------------
Private Sub Form_Load()
 
End Sub
---------------------------------
Private Sub Text20_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Len(Text20) >= 0 And Len(Text20) <= 3 Then
   msg = "Eingabe ist nicht richtig"
   msg1 = MsgBox(msg, vbCritical)
   Text20 = ""
   Text20.SetFocus
End If
If Len(Text20) = 4 Then
   cmd_auswahl.SetFocus
End If
End If
End Sub
Private Sub Combo1_KeyPress(KeyAscii As Integer)
MAuswahl = Combo1.text 
frmAbfrag.Show
End Sub

Private Sub Form_Load()
Show
suchen = False
vorJahr = Format$(Date, "yyyy")
vorJahr1 = vorJahr - 1
vorJahr = "31.12." + Str(vorJahr1)
vorJahr = Format$(MAuswahl, "\#mm\/dd\/yyyy\#")
frmAbfrag.Caption = "Abfrage aus dem Jahr " + Str(vorJahr1)
vorjahr2 = "31.12.2011"
vorjahr3 = Format$(vorjahr2, "\#mm\/dd\/yyyy\#")
textleer
gesAbfrage
End Sub
----------------------------
Function gesAbfrage()
'Set conn = New ADODB.Connection
'conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data" & _
  "Source=\\Server\Faktura\faktura\datenbank\faktur3.mdb;Persist Security" & _
  "Info=False"
datenOpen
SQLAbfrage = "SELECT artikel.artnr, artikel.artbez, artikel.VPEINHEIT," & _
  "artikel.me, " _
& "stammdat.kdnr, stammdat.name, stammdat.plz, stammdat.ort, rechnung.renr, " _
& "rechnung.rechDat, rechnung.preis, rechnung.stueck, rechnung.gesmenge," & _
"rechnung.liefnr, " _
& "rechnung.rabatt, rechnung.gespreis, rechnung.vskosten, rechnung.storno " _
& "FROM (stammdat INNER JOIN rechnung ON stammdat.kdnr = rechnung.kdnr) INNER" & _
"JOIN artikel ON rechnung.artnr = artikel.artnr " _
& "WHERE rechdat >=" & MAuswahl _
& " And storno = False " _
& "ORDER by rechdat ASC, renr ASC;"
Abfrage = absql((SQLAbfrage))
End Function