VBA에 액세스하여 첨부 파일 (QueryDef)이 포함 된 메일을 루프로 보내십시오.

Question

무엇을하려고합니까?

각 메일 항목을 만들려고합니다. 이 메일 항목에는 첨부 파일로 임시 쿼리가 있어야합니다. via TransferSpreadSheet 임시 쿼리를 폴더로로드합니다.

문제를 나타내는 코드 부분을 붙여 넣으십시오.

문제는 쿼리입니다. 그것은 항상 각 데이터에 대한 첨부 파일이 아니라 동일한 데이터를 보여줍니다. 내 루프에 쿼리 def를 포함시켜야한다고 제안하지만, 나는 당신의 도움이 필요합니다.

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("Mailversand") 'Get name for the email distro 

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 = "Anfrage_zur_Ausschreibung" Then 
        dbs.QueryDefs.Delete "Anfrage_zur_Ausschreibung" 
        Exit For 
       End If 
      Next 

      Set qdfTemp = dbs.CreateQueryDef("Anfrage_zur_Ausschreibung") 
      With dbs 
       'Run query on selected Name product manager 
       qdfTemp.SQL = "SELECT * FROM [Filter_Ausschreibung_original] WHERE [Lieferant] = '" & rs![Lieferant] & "'" 
       DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Anfrage_zur_Ausschreibung", "Q:\LU\Test\Anfrage_zur_Ausschreibung.xlsx", True 

      End With 

     .To = toMulti 
     MsgBox toMulti 
     .Subject = "Anfrage zu Ausschreibung" 
     .HTMLBody = "Sehr geehrte Damen und Herren" 
     .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 

예상되는 결과는 무엇입니까? 각 rs에는 다른 첨부 파일이 있어야합니다. "Lieferant"에 속한 부분.

실제로 얻은 결과는 무엇입니까? (오류를 포함하십시오.) 첨부 파일이 하나 뿐이지 만 항상 동일한 내용으로되어 있습니다.

업데이트 저는 파르페 솔루션을 사용하려고합니다.

'Export temp table to Excel 
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _ 
      "Anfrage_zur_Ausschreibung_TEMP", _ 
      "Q:\LU\_Rothenhöfer\Test\Anfrage_zur_Ausschreibung_TEMP.xlsx", True 

전체 코드는 이제 :

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("Mailversand") 'Get name for the email distro 

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 

     Set qdfTemp = dbs.CreateQueryDef("Anfrage_zur_Ausschreibung") 
     qdfTemp.SQL = "PARAMETERS LieferantParam Text (255); " & _ 
         "SELECT * INTO Anfrage_zur_Ausschreibung_TEMP " & _ 
         "From Filter_Ausschreibung_original " & _ 
         "WHERE [Lieferant] = rs![Lieferant]" 

     Set qdfTemp = Nothing 

     'Export temp table to Excel 
     DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _ 
       "Anfrage_zur_Ausschreibung_TEMP", _ 
       "Q:\LU\Test\Anfrage_zur_Ausschreibung.xlsx", True 

     .To = toMulti 
     MsgBox toMulti 
     .Subject = "Anfrage zu Ausschreibung" 
     .HTMLBody = "Sehr geehrte Damen und Herren" 
     .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 

내가 잘못하고있는 중이 야 무슨 문제는 이제 다음과 같은 부분에 오류가? 그러나

' UPDATE QUERY 
Set qdfTemp = dbs.CreateQueryDef("Anfrage_zur_Ausschreibung") 
qdfTemp.SQL = "<SQL Query>" 
Set qdfTemp = Nothing     ' RELEASES QUERYDEF 

' EXPORT QUERY TO EXCEL 
DoCmd.TransferSpreadsheet acExport ... 

을 삭제하고 SQL 문에 VBA 변수를 연결하여 쿼리를 다시 작성하는이 방법을 재고 :

Answer 1

은 단순히 당신의 SQL을 업데이트 한 후, 그렇지 않으면 변경이 전파되지 않으며, 당신의 QTEMP를 놓습니다. 더 깨끗하고 유지 보수가 가능하며 약간 효율적인 코드를 위해 parameterization을 고려해보십시오.이 코드는 Excel 내보내기를위한 임시 테이블을 반복적으로 만듭니다.

이 (PARAMETERS 절을 사용하여 영구 테이블 만들기 실행 쿼리로 저장) SQL

PARAMETERS LieferantParam TEXT; 
SELECT * INTO Anfrage_zur_Ausschreibung_TEMP 
FROM [Filter_Ausschreibung_original] 
WHERE [Lieferant] = [LieferantParam]; 

VBA(현재 유일한 매개 변수로 작용 위의 실행 루프 섹션)

Do Until rs.EOF  
    With mItem 
     Set mItem = olApp.CreateItem(olMailItem) 
     .BodyFormat = olFormatHTML 
     toMulti = rs![email] 
     waarde = toMulti 

     'Retrieve make-table query and bind parameter to name product manager 
     Set qdfTemp = dbs.QueryDef("Anfrage_zur_Ausschreibung_QUERY") 
     qdfTemp![LieferantParam] = rs![Lieferant] 
     qdfTemp.Execute, dbFailOnError 

     'Export temp table to Excel 
     DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _ 
       "Anfrage_zur_Ausschreibung_TEMP", _ 
       "Q:\LU\Test\Anfrage_zur_Ausschreibung.xlsx", True 

     .To = toMulti 
     MsgBox toMulti 
     .Subject = "Anfrage zu Ausschreibung" 
     .HTMLBody = "Sehr geehrte Damen und Herren" 
     .Display 
     .Attachments.Add ("Q:\LU\Test\Anfrage_zur_Ausschreibung.xlsx")  
    End With  
    rs.MoveNext 
Loop