Function Schleife()
Dim i As Long
For i = 1 To 21
  ' CurrentDb.Execute "DELETE * FROM txls_Zeile"
  CurrentDb.Execute "INSERT INTO txls_Zeile SELECT txls_Verteiler.* " & _
    "FROM txls_Verteiler WHERE txls_Verteiler.Nr = " & i & " AND" & _
    "txls_Verteiler.Filteraktiv = True"
 Next i
End Function

Function Transfer_zu_xls()
On Error GoTo m_GK_Report_xls_transfer_Err
 
  DoCmd.SetWarnings False
 
 
  ' Die Auswahl im Formular fxls_Export_Steuerung wird in die Tabelle 
  ' txls_Export_Steuerung geschrieben
  ' DoCmd.RunSQL "UPDATE txls_Export_Steuerung SET txls_Export_Steuerung.KoStBL" & _
    "= IIf(" & _
    "Formulare!fxls_Export_Steuerung!Kombinationsfeld1='Alle','*',Formulare!fx" & _
    "s_Export_Steuerung!Kombinationsfeld1), txls_Export_Steuerung.XBuKrs =" & _
    "Formulare!fxls_Export_Steuerung!Kombinationsfeld0;", -1
 
  ' Transfertyp: Exportieren / Dateiformat: Microsof Excel 8.0 / Tabellenname: 
  ' qGK_Report_Excel / Dateiname: O:\ber\2008\BMS\GK_Report.xls  / Feldnamen: 
  ' Ja / Bereich: leer
  DoCmd.TransferSpreadsheet acExport, 8, "qGK_Report_Excel", _
    "O:\ber\2008\BMS\GK_Report.xls", True, ""
  ' Transfertyp: Exportieren / Dateiformat: Microsof Excel 8.0 / Tabellenname: 
  ' qGK_BewegKost / Dateiname: O:\ber\2008\BMS\GK_Report.xls  / Feldnamen: Ja / 
  ' Bereich: leer
  DoCmd.TransferSpreadsheet acExport, 8, "qGK_BewegKost", _
    "O:\ber\2008\BMS\GK_Report.xls", True, ""
  ' Transfertyp: Exportieren / Dateiformat: Microsof Excel 8.0 / Tabellenname: 
  ' tSteuerung_zeit / Dateiname: O:\ber\2008\BMS\GK_Report.xls  / Feldnamen: Ja 
  ' / Bereich: leer
  DoCmd.TransferSpreadsheet acExport, 8, "tSteuerung_Zeit", _
    "O:\ber\2008\BMS\GK_Report.xls", True, ""
 
m_GK_Report_xls_transfer_Exit:
  Exit Function
 
m_GK_Report_xls_transfer_Err:
  MsgBox Error$
  Resume m_GK_Report_xls_transfer_Exit
 
End Function

Private Sub EMail_Senden()
  ' Outlook Applikation
  Dim ool As Outlook.Application
  Dim oInspector As Outlook.Inspector
  Dim oMail As Outlook.MailItem
  Dim myattachments As Variant
 
 
  ' Verweis zu Outlook + neue Nachricht
  Set ool = CreateObject("Outlook.Application")
  Set oMail = ool.CreateItem(olMailItem)
  Set myattachments = oMail.Attachments
 
  ' Befreff-Zeile
  oMail.Subject = "Stand dieser Liste: " & _
    Format(Date, "Long Date") & " !"
 
  ' An-Zeile (Empfänger)
  oMail.To = DLookup("[EMail]", "txls_Zeile")  ' "xyz@web.de"
  oMail.Recipients.ResolveAll
  oMail.Display
 
  ' Texteingabe (Nachricht selbst)
  oMail.Body = "Hier die Exceldatei, bitteschön..."
 
 
  ' Anhang
  ' Der vollständiger Pfad muß angegeben sein.
  ' Es können auch weitere Dateien angegeben werden.
  ' Hierzu einfach mit myattachments.Add "???" fortsetzen.
  myattachments.Add "D:\_o\Ber\2008\GK_Report.xls"
 
' oMail.Save
' oMail.Send
 
  ' Speicher freigeben
  Set ool = Nothing
  Set oInspector = Nothing
  Set oMail = Nothing
End Sub