For each recordset create a mail with the query as attachement

[DR1989]

I'm trying to create for each rs a mail item. This mail item should have a temporary query as attachement. Via TransferSpreadSheet I load my temporary Query into Folder.
This is working. But now, after creating the mail, my attachement is always the same.
I'm also thinking about a solution which is loading my query results in a excel template, and then send the email with my loaded template as attachement. The template would have a better design, as my "transferspreadsheet" - attachement.

First question: What am I doing wrong, with my acutal VBA?


Second question: Is it possible to load the query result for each recordset in a template and send them out?

 
Sub ExcelExportuSenden()
 Dim day As Integer
 day = Weekday(Date, vbSunday)
 Dim olApp As Outlook.Application
 Dim toMulti, waarde As String
 Dim mItem As Outlook.MailItem  ' An Outlook Mail item
 Dim dbs As Database
 Dim qdfTemp As QueryDef
 Dim qdfNew As QueryDef
 Dim originalSql As String
 Dim Identified_name As Recordset
 Dim qdf As DAO.QueryDef
 Set dbs = CurrentDb
 Set olApp = CreateObject("Outlook.Application")
 Set mItem = olApp.CreateItem(olMailItem)
 Dim rs  As Recordset
 Set rs = CurrentDb.OpenRecordset("Mailrecipient")  'Get name for the email recipient
 If rs.RecordCount > 0 Then
     rs.MoveFirst
     Do Until rs.EOF
         With mItem
             Set mItem = olApp.CreateItem(olMailItem)
             .BodyFormat = olFormatHTML
             toMulti = rs![email]
             waarde = toMulti
             For Each qdf In dbs.QueryDefs
                 If qdf.Name = "inquiry" Then
                    dbs.QueryDefs.Delete "inquiry"
                    Exit For
                 End If
             Next
             Set qdfTemp = dbs.CreateQueryDef("inquiry")
             With dbs
                'Run query on selected Name product manager
                 qdfTemp.SQL = "SELECT * FROM [query_each_supplier] WHERE [supplier] = '" & rs![supplier] & "'"
                 DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "inquiry", "Q:\LU\Test\inquiry.xlsx", True
             End With
         .To = toMulti
         MsgBox toMulti
         .Subject = "inquiry"
         .HTMLBody = ""
         .Display
         .Attachments.Add ("Q:\LU\Test\Anfrage_zur_Ausschreibung.xlsx")
     End With
        rs.MoveNext
     Loop
 Else
     MsgBox "No email address!"
 End If
 olApp.Quit
 Set olApp = Nothing
 Exit Sub
 End Sub

Many thanks!

[ranman256]

why does the attached file: "Q:\LU\Test\Anfrage_zur_Ausschreibung.xlsx"
not the same file as the one you exported:"Q:\LU\Test\inquiry.xlsx"
?

[DR1989]

Sorry, this was a mistake from me, as I translate it in english. Of course it's the same, but it do not work