Sub ExcelExportuSenden()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qd As DAO.QueryDef
Dim sSQL As String
Dim oApp As Outlook.Application
Dim oMail As MailItem
Dim fileName As String
Set db = CurrentDb
Set qd = db.CreateQueryDef("Lieferant", "SELECT * FROM [Filter_Ausschreibung_original] WHERE 1 = 0")
Set qd = Nothing
Set rs = db.OpenRecordset( _
"SELECT DISTINCT [Lieferant] FROM [Filter_Ausschreibung_original] ", _
dbOpenForwardOnly)
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(olMailItem)
With rs
Do While Not .EOF
sSQL = "SELECT * FROM [Filter_Ausschreibung_original] " & _
" WHERE Lieferant = '" & .Fields("Lieferant") & "'"
db.QueryDefs("Anfrage").SQL = sSQL
Debug.Print sSQL
.MoveNext
Loop
.Close
End With
With oMail
.Subject = ""
.Body = "Sehr geehrte Damen und Herren," & vbCr & "" & vbCr & "anbei erhalten Sie" & _
vbCr & "" & vbCr & "- die Auftragsbestätigung für die erbrachte Dienstleistung vor Ort" & _
vbCr & "- die Prüfbescheinigungen für die wiederkehrende Prüfung vor Ort" & _
vbCr & "- die aktuelle Übersicht der Schlauchleitungen." & _
vbCr & "" & vbCr & "Die Rechnung senden wir separat an die angegebene Rechnungsadresse." & _
vbCr & "" & vbCr & "Für eventuelle Rückfragen stehen wir Ihnen zur Verfügung, gerne auch persönlich nach Terminvereinbarung." & _
vbCr & "" & vbCr & "Mit freundlichen Grüßen" & _
vbCr & "" & vbCr & ""
.Display
End With
db.QueryDefs.Delete "Lieferant"
Set rs = Nothing
Set db = Nothing
End Sub
<strong>Mein Code erstellt immer nur eine Mail, danach passiert aber gar nix mehr...Es muss also irgendwas in der Schleife verändert werden...nur was?</strong>