MS Access將記錄源轉換為SQL

Question

我有一個從SQL查詢字符串生成HTML表的函數。

我想獲取包含所有過濾器的當前活動報表的查詢字符串，並從中生成一個HTML表。 然后，可以將其包含在Outlook電子郵件中。

我正在嘗試創建一個執行以下操作的函數：

1. 打開MS Outlook。
2. 打開一個已經制作好的模板。
3. 用當前活動報告生成的表替換模板中的字符串。
4. 將當前活動的報告添加為PDF附件。

這是我的代碼：

Option Compare Database
Option Explicit

Private Sub emailSupplier_Click()
    ' Define the parameters
    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    Dim objOutlookAttach As Outlook.Attachment
    Dim templateExpediter As String
    Dim msgBody As String
    Dim strFind As String
    Dim strNew As String
    Dim currentReport As Report
    Dim query As String

    ' Set the params
    Set currentReport = Screen.ActiveReport
    Set query = currentReport.RecordSource
    Set templateExpediter = "D:\Templates\expediter.oft"
    ' Create the Outlook session.
    Set objOutlook = CreateObject("Outlook.Application")
    ' Create the message.
    Set objOutlookMsg = objOutlook.CreateItemFromTemplate(templateExpediter)

    With objOutlookMsg
       ' Add the To recipient(s) to the message.
       Set objOutlookRecip = .Recipients.Add("firstmail")
       objOutlookRecip.Type = olTo

       ' Add the CC recipient(s) to the message.
       Set objOutlookRecip = .Recipients.Add("secondamail")
       objOutlookRecip.Type = olCC

       ' Set the Subject, Body, and Importance of the message.
       .BodyFormat = olFormatHTML
       .Subject = "Urgent Delivery Request - " & Date
       .Importance = olImportanceHigh 'High importance

       strFind = "{X}"
       ' Get HTML from the query for the record set
       strNew = GenHTMLTable(query)
       .HTMLBody = Replace(.HTMLBody, strFind, strNew)

       ' Resolve each Recipient's name.
       For Each objOutlookRecip In .Recipients
          objOutlookRecip.Resolve
       Next

       ' Should we display the message before sending?
       'If DisplayMsg Then
          '.Display
       'Else
          .Save
          .Display
       'End If

    End With
    Set objOutlook = Nothing

End Sub

我的問題是如何將當前的活動報告記錄源或集合轉換為活動的HTML表？

或者至少獲取帶有過濾器的SQL查詢，以便我可以使用QueryToHtmlTable(Query)函數生成。

• 編輯2-好的，所以我得到了帶有過濾器的正確SQL。 現在看來，從sql生成HTML的功能給我一個錯誤“在集合中找不到項目”

   Function GenHTMLTable(sQuery As String, Optional bInclHeader As Boolean = True) As String On Error GoTo Error_Handler Dim db As DAO.Database Dim qdf As DAO.QueryDef Dim prm As DAO.Parameter Dim rs As DAO.Recordset Dim fld As DAO.Field Dim sHTML As String Set db = CurrentDb Set qdf = db.QueryDefs(sQuery) For Each prm In qdf.Parameters prm = Eval(prm.Name) Next prm Set rs = qdf.OpenRecordset With rs sHTML = "<table>" & vbCrLf If bInclHeader = True Then 'Build the header row if requested sHTML = sHTML & vbTab & "<tr>" & vbCrLf For Each fld In rs.Fields sHTML = sHTML & vbTab & vbTab & "<th>" & fld.Name & "</th>" & vbCrLf Next sHTML = sHTML & vbTab & "</tr>" & vbCrLf End If If .RecordCount <> 0 Then Do While Not .EOF 'Build a row for each record in the recordset sHTML = sHTML & vbTab & "<tr>" & vbCrLf For Each fld In rs.Fields sHTML = sHTML & vbTab & vbTab & "<td>" & fld.Value & "</td>" & vbCrLf Next sHTML = sHTML & vbTab & "</tr>" & vbCrLf .MoveNext Loop End If sHTML = sHTML & "</table>" End With GenHTMLTable = sHTML Error_Handler_Exit: On Error Resume Next If Not fld Is Nothing Then Set fld = Nothing If Not rs Is Nothing Then rs.Close Set rs = Nothing End If If Not db Is Nothing Then Set db = Nothing Exit Function Error_Handler: MsgBox "The following error has occured" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: GenHTMLTable" & vbCrLf & _ "Error Description: " & Err.Description & _ Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _ , vbOKOnly + vbCritical, "An Error has Occured!" Resume Error_Handler_Exit End Function 

回答

    Dim currentReport As Report
    Dim strSQL As String

    ' Set the params
    Set currentReport = Screen.ActiveReport
    ' Replace double qoutes with single qoutes
    strSQL = Replace(currentReport.RecordSource, ";", "") & " AND " & currentReport.filter
    strSQL = Replace(strSQL, Chr(34), "'")
    strSQL = Replace(strSQL, ")", "")
    strSQL = Replace(strSQL, "(", "")

Answer 1

如果我了解您的需求，

打開報告進行預覽后，您想獲取用於生成報告的過濾器，然后將其與報告一起郵寄。

我建議有一個功能來生成報告，然后郵寄它

Function GenerateAndMailReport
    Dim strRecordSourceSample
    strRecordSourceSample = "reportQuery"
    Dim strFilterSample
    strFilterSample = "[SomeID] = 109902"
    Call DoCmd.OpenReport("reportName", acViewPreview, , strFilterSample)
    Call emailSupplier(strRecordSourceSample, strFilterSample) 'Passing the filter and record source to your mailing function
End Function

-編輯-

如果您已經可以訪問報表對象，則可以獲取

currentReport.RecordSource
currentReport.Filter

https://msdn.microsoft.com/VBA/Access-VBA/articles/report-recordsource-property-access https://msdn.microsoft.com/VBA/Access-VBA/articles/report-filter-property-access

它們都將返回您可以用來打開記錄集的字符串

Dim SQL As String
Dim QRY As New ADODB.Recordset

SQL = currentReport.RecordSource & " WHERE " & currentReport.Filter
QRY.Open SQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
While Not oQRY.EOF
HtmlLogicHere()
Wend
oQRY.Close

如果您在記錄集中已經有WHERE子句，請小心，連接將有所不同。

Answer 2

如果在“ OpenReport”方法中設置了“報表過濾器”屬性，或右鍵單擊快捷菜單：

strSQL = Replace(Reports!report.RecordSource, ";","") & " WHERE " & Reports!report.Filter

不幸的是，如果報表RecordSource是動態參數化查詢，則參數值將不在RecordSource sql中，而僅在變量引用中。