Question

我正在尝试根据特定字段发送报告并循环显示，以便每个ID的报告都会消失，而不只是包含所有ID及其数据的大文件。（具体而言，我正在尝试根据他们的身份证号码[或被叫领土]向每个销售人员发送他们的销售信息 - 他们的身份证号码是rs.fields（1））。但是，使用我当前的代码，它仍然发送整个报告，而不仅仅是基于每个ID的报告。任何帮助将不胜感激！

以下是我的报告代码：

Dim rs As DAO.Recordset
Dim fld As DAO.Field
Dim territory As String
Dim strSQL As String
Dim strSQL2 As String
Dim strSQL3 As String
Dim strQry As String
Dim qdf As QueryDef
Dim qdf2 As QueryDef
Dim dbs As Database
Dim i As Integer
Dim timestamp As String
DoCmd.OpenForm "Sales Email"
Forms![Sales Email]![FromDate].SetFocus

timestamp = Format(Forms![Sales Email]![FromDate].Value, "mm-yyyy")

Set rs = DBEngine(0)(0).OpenRecordset("KNOXLIVE_Engineers_Test")

For Each fld In rs.Fields
Do While Not rs.EOF
territory = rs.Fields(1)
Set dbs = CurrentDb
strSQL = "SELECT * FROM 001_SALES_OUTPUT_FOR_CURRENT_MONTH WHERE TERRITORY = """ & rs.Fields(1) & """"
strSQL2 = "SELECT * FROM CURRENT_OPEN_ORDERS WHERE TERRITORY = """ & rs.Fields(1) & """"
'MsgBox (strSQL)
Set qdf = dbs.CreateQueryDef("TheNewQueryDef", strSQL)
DoCmd.OutputTo acOutputQuery, "TheNewQueryDef",  acFormatXLS, "\\cletus\data\accounting\Regional Sales Reporting\Monthly Sales Database Files By Month\Monthly Sales for " & territory & " " & timestamp & ".xls", False
CurrentDb.QueryDefs.Delete qdf.Name
Set qdf2 = dbs.CreateQueryDef("TheNewQueryDef", strSQL2)
DoCmd.OutputTo acOutputQuery, "TheNewQueryDef", acFormatXLS, "\\cletus\data\accounting\Regional Sales Reporting\Monthly Sales Database Files By Month\Current Open Orders for " & territory & " " & timestamp & ".xls", False
CurrentDb.QueryDefs.Delete qdf.Name
DoCmd.OpenReport "Final Report with Gauges", acViewPreview, , "TERRITORY=" & rs.Fields(1), , acHidden
DoCmd.OutputTo acOutputReport, "Final Report with Gauges", acFormatPDF, "\\cletus\data\accounting\Regional Sales Reporting\Monthly Sales Database Files By Month\Actual Sales vs Budget for " & territory & " " & timestamp & ".PDF", False
DoCmd.Close acReport, "Final Report with Gauges"
Dim filename As String
Dim filename2 As String
Dim filename9 As String

    filename = "\\cletus\data\accounting\Regional Sales Reporting\Monthly Sales Database Files By Month\Monthly Sales for " & territory & " " & timestamp & ".xls"

    filename2 = "\\cletus\data\accounting\Regional Sales Reporting\Monthly Sales Database Files By Month\Current Open Orders for " & territory & " " & timestamp & ".xls"

    filename9 = "\\cletus\data\accounting\Regional Sales Reporting\Monthly Sales Database Files By Month\Actual Sales vs Budget for " & territory & " " & timestamp & ".PDF"

    Set objmessage = CreateObject("CDO.Message")

    objmessage.Subject = "Monthly Sales & Current Open Orders for " & territory & " " & timestamp & ""

    objmessage.From = "email@email.com"

    'This sends each territory owner their proper file based on KX code
    objmessage.to = rs.Fields(2)
    objmessage.cc = rs.Fields(5)
    objmessage.bcc = "email@email.com"

    objmessage.Textbody = "Please find attached the monthly sales, current open orders, and actual sales vs budget for " & territory & vbCr & vbCr & "Thanks!" & vbCr & vbCr & "Name Here"

    objmessage.AddAttachment filename
    objmessage.AddAttachment filename2
    objmessage.AddAttachment filename9

    'This section provides the configuration information for the remote SMTP server.
    'Normally you will only change the server name or IP.
    objmessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

    'Name or IP of Remote SMTP Server
    objmessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "scratchy"

    'Server port (typically 25)
    objmessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

    objmessage.Configuration.Fields.Update

    'End remote SMTP server configuration section==

    objmessage.Send



rs.MoveNext
Loop
Next
Debug.Print

rs.Close

DoCmd.OutputTo基于字段的acOutputReport

0 个答案: