报告中的DoCmd.OpenReport和ORDER BY

时间:2019-06-17 10:22:19

标签: sql vba ms-access sql-order-by

我在MS Access中有一个电子邮件报告,它现在报告所有真实状态的销售。在报告中,我们有ID,地址,郊区,销售价格,土地,床位,评估和销售代理。

该代码现在正在运行,但我想通过SUBURB对其进行订购。我试图将其放在WhereCondition中,但不起作用。


qry = qry & ") And [COND DATE] >= CDate(""" & Me.txtDateStart2.Value & """)" & " And [COND DATE] <= CDate(""" & Me.txtDateEnd2.Value & """) ORDER BY [SUBURB]"
DoCmd.OpenReport "rptStageThree", acViewReport, , qry
DoCmd.OutputTo acReport, "rptStageThree", "MicrosoftExcelBiff8(*.xls)", CurrentProject.Path & "\" & suburpsCol(1).Contact & ".xls", False, "", 0

我仍在尝试在这里找到的其他选项,例如在DoCmd.OpenReport中使用OpenArgs参数:

qry = qry & ") And [COND DATE] >= CDate(""" & Me.txtDateStart2.Value & """)" & " And [COND DATE] <= CDate(""" & Me.txtDateEnd2.Value & """)"
DoCmd.OpenReport "rptStageThree", acViewReport, , qry, , "ORDER BY [SUBURB]"
DoCmd.OutputTo acReport, "rptStageThree", "MicrosoftExcelBiff8(*.xls)", CurrentProject.Path & "\" & suburpsCol(1).Contact & ".xls", False, "", 0

这是我的全部代码:


Private Sub EmailProofToOffices_Click()
Dim qry As String
Dim col As New Collection
Dim suburpsCol As Collection
Dim db As DAO.Database
Dim rsEdit As DAO.Recordset
Dim lItem As Long
Dim item
Dim OfficeCentralItem  As OfficeCentralReportsItem

Dim OutApp As Object
Dim OutMail As Object

    For lItem = 0 To Me.List40.ListCount - 1
        If Me.List40.selected(lItem) Then
            col.Add Me.List40.ItemData(lItem)
        End If
    Next lItem

        For Each item In col
            Set db = CurrentDb
            Set rsEdit = db.OpenRecordset(Constants.OfficeCentralTHOMPSONTABLE)
                'rsEdit.MoveFirst
            Set suburpsCol = New Collection
                 Do While Not rsEdit.EOF

                     If Trim(item) = Trim(rsEdit.Fields("Office").Value) Then
                         Set OfficeCentralItem = New OfficeCentralReportsItem
                         OfficeCentralItem.Suburbs = rsEdit.Fields("Suburbs").Value
                         OfficeCentralItem.EmailAddress = rsEdit.Fields("Email Address").Value
                         OfficeCentralItem.Contact = rsEdit.Fields("Contact").Value
                         suburpsCol.Add OfficeCentralItem
                     End If
                rsEdit.MoveNext
                Loop
                If suburpsCol.Count > 0 Then
                    If Me.txtDateStart2.Value <> "" And Me.txtDateEnd2.Value <> "" Then
                        If Not IsNull(Me.txtDateStart2.Value) And Not IsNull(Me.txtDateEnd2.Value) Then
                                qry = ""
                            For Each OfficeCentralItem In suburpsCol
                                If qry = "" Then
                                    qry = qry & "([SUBURB]= " & """" & OfficeCentralItem.Suburbs & """"
                                Else
                                    qry = qry & "Or [SUBURB]= " & """" & OfficeCentralItem.Suburbs & """"
                                End If
                            Next
                                qry = qry & ") And [COND DATE] >= CDate(""" & Me.txtDateStart2.Value & """)" & " And [COND DATE] <= CDate(""" & Me.txtDateEnd2.Value & """)"
                                DoCmd.OpenReport "rptStageThree", acViewReport, , qry
                                DoCmd.OutputTo acReport, "rptStageThree", "MicrosoftExcelBiff8(*.xls)", CurrentProject.Path & "\" & suburpsCol(1).Contact & ".xls", False, "", 0

                                  'Email Part
                                    Set OutApp = CreateObject("Outlook.Application")
                                    Set OutMail = OutApp.CreateItem(0)

                                        With OutMail
                                            .Display
                                            .To = suburpsCol(1).EmailAddress
                                            .Subject = sTitle
                                            Body = .HTMLBody
                                            '.HTMLBody = "<table><tr>Hi  " & suburpsCol(1).Contact & ",</tr><tr/><tr/><tr>Please find the attached spreadsheet containing records of sales in your group of suburbs for " & Me.txtDateStart2.Value & " to " & Me.txtDateEnd2.Value & ".</tr><tr/><tr/><tr>Proof data now includes details of Sale Price %/Valuation, List Date and Days on Market.  This will not be included in final reports but may be useful to quickly identify sales where the details returned to REINZ contains errors.</tr><tr/><tr/><tr>Could you please confirm if this data is approved for use or if you have any changes.  Where no response is received within 3 business days final PDF reports and graphs will be built with the data as is.  Changes are not possible after deadline for technical reasons.</tr><tr/><tr/><tr>Many thanks,</tr><tr>Aaron and team.</tr></table>"
                                            .Attachments.Add CurrentProject.Path & "\" & suburpsCol(1).Contact & ".xls"
                                        End With
                                    Set OutMail = Nothing
                                    Set OutApp = Nothing
                        End If
                    End If
                End If
           Set suburpsCol = Nothing
           Set rsEdit = Nothing
           Set db = Nothing
        Next
End Sub

如何添加该语法以放入“按订单依据”条件? 有人可以帮我吗?

谢谢。

1 个答案:

答案 0 :(得分:0)

.OpenReport的WhereCondition参数仅提供了一个过滤器字符串,您无法在其中进行排序。

由于某些原因,Access女士的报告会忽略其记录源中的排序顺序SQL。要change Order By for report data,您必须在Group & Sort上使用Design View,或在OrderBy事件中设置Report_Open属性,例如,OpenArgs参数1}}:

DoCmd.OpenReport

通过以下方式打开报告:

Private Sub Report_Open(Cancel As Integer)
If Not IsNull(Me.OpenArgs) Then
    Me.OrderBy = Me.OpenArgs
    Me.OrderByOn = True
End If
End Sub