Create RecordSet from Form Parameters

[kirschey]

I am trying to use a form data to modify a query and store it as a recordset.

I have it working properly just opening the query, but I cannot seem to get the QueryDef parameters working the way I would like. (The Me.Territory,Me.State, and Me.Brand is the form data).

I get the error "Item not found in this collection." Currently.

The code that doesn't work:

    'create the recordset
    Set db = CurrentDb()
    Set qdf = db.QueryDefs(stDocName)
 
    'Query Parameters
    qdf.Parameters("Region") = Me.Territory
    qdf.Parameters("State") = Me.State
    qdf.Parameters("Brand") = Me.Brand
 
    Set rs = qdf.OpenRecordset()
    If rs.RecordCount = 0 Then Exit Sub

[ADezii]

@kirschey
I created a Generic Routine which will resolve your Query Parameters based on the appropriate Form Values. This logic will work on any Query that has referenced Form Values as criteria, namely:

Forms![<Your Form Name>]![<Your Field Name>]    'in 1 or more Criteria Rows

Dim rs As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim db As DAO.Database
Dim prm As DAO.Parameter
Dim stDocName As String
 
stDocName = "<Query Name here>"
 
Set db = CurrentDb()
Set qdf = db.QueryDefs(stDocName)
 
'Resolve the Parameters
For Each prm In qdf.Parameters
  prm.Value = Eval(prm.Name)
Next
 
Set rs = qdf.OpenRecordset(dbOpenDynaset)
 
rs.MoveLast: rs.MoveFirst
 
If rs.RecordCount = 0 Then Exit Sub
 
With rs
  Do Until .EOF
    'process Records within Loop
    .MoveNext
  Loop
End With
 
rs.Close
Set rs = Nothing

[kirschey]

[quote=ADezii;3479511]

'Resolve the Parameters
For Each prm In qdf.Parameters
  prm.Value = Eval(prm.Name)
Next
 

Thanks for the help. I still don't get how I would adapt my form inputs into the For loop. Would I use an array?

[kirschey]

I am still getting the error. Maybe it is from another part?

[ADezii]

@kirschey
Post the SQL for the Query.

[kirschey]

It is ugly. I am sorry.


This is the query "output."

SELECT [zz Profit and Loss Flow Final].[Year-Month], Sum([zz Profit and Loss Flow Final].[Cases Shipped]) AS [Cases Shipped], Sum([zz Profit and Loss Flow Final].[Cases Depl]) AS [Cases Depl], Sum([zz Profit and Loss Flow Final].[Cases Depl Budget]) AS [Cases Depl Budget], Sum([zz Profit and Loss Flow Final].[Gross Profit]) AS [Gross Profit], Sum([zz Profit and Loss Flow Final].SPAs) AS SPAs, Sum([zz Profit and Loss Flow Final].Samples) AS Samples, Sum([zz Profit and Loss Flow Final].[Other Selling Exp]) AS OtherSellingExp, Sum([zz Profit and Loss Flow Final].Salaries) AS Salaries, Sum([zz Profit and Loss Flow Final].[Travel & Enter]) AS [Travel & Enter], Sum([zz Profit and Loss Flow Final].[Primary Budget]) AS [OfPrimary Budget], Sum([zz Profit and Loss Flow Final].[T&E Bud]) AS [T&E Bud], Sum([zz Profit and Loss Flow Final].[Add'l Budget]) AS [Add'l Budget], Sum([zz Profit and Loss Flow Final].[Sal Budget]) AS [Sal Budget]
FROM [zz Profit and Loss Flow Final]
WHERE ((([zz Profit and Loss Flow Final].Region) Like "*" & Forms!sort.territory & "*") And (([zz Profit and Loss Flow Final].State) Like "*" & Forms!sort.state & "*") And (([zz Profit and Loss Flow Final].Brand) Like "*" & Forms!sort.brand & "*"))
GROUP BY [zz Profit and Loss Flow Final].[Year-Month];
 

Here is the vb code I am working on to dump the query into a specially formatted excel spreadsheet one cell at a time. It is the record set that is giving me some trouble at the moment because I am not doing something properly in the parameters section.

Option Compare Database
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim prm As DAO.Parameter
Private Sub Run_Click()
On Error GoTo Err_Run_Click
    Dim stTerritory As String
    Dim stState As String
    Dim stBrand As String
    Dim dFirstMonth As Date
    Dim stDocName As String
    Dim Suc As Boolean
    stDocName = "output"
    dFirstMonth = Me.firstmonth
 
    If Me.Territory <> "" Then
        stTerritory = Me.Territory
    Else
        stTerritory = "All"
    End If
    If Me.State <> "" Then
        stState = Me.State
    Else
        stState = "All"
    End If
    If Me.Brand <> "" Then
        stBrand = Me.Brand
    Else
        stBrand = "All"
    End If
 
    'create the recordset
    Set db = CurrentDb()
    Set qdf = db.QueryDefs(stDocName)
    'Query Parameters
    qdf.Parameters("Region") = Me.Territory
    qdf.Parameters("State") = Me.State
    qdf.Parameters("Brand") = Me.Brand
 
    'Resolve the Parameters
    For Each prm In qdf.Parameters
       prm.Value = Eval(prm.Name)
    Next
 
    Set rs = qdf.OpenRecordset(dbDynaset)
    rs.MoveLast: rs.MoveFirst
 
    If rs.RecordCount = 0 Then Exit Sub
 
    'DoCmd.OpenQuery stDocName, acNormal, acReadOnly
Exit_Run_Click:
    Suc = PrintSheet(stTerritory, stState, stBrand, dFirstMonth)
 
    Exit Sub
Err_Run_Click:
    MsgBox Err.Description
    Resume Exit_Run_Click
End Sub
 
Public Function PrintSheet(Territory As String, State As String, Brand As String, firstmonth As Date)
 
    Dim xlApp As Excel.Application
    Dim xlWB1 As Excel.Workbook
    Dim currentmonth As Date
    Dim x As Integer
    Dim y As Integer
 
    Set xlApp = New Excel.Application
    xlApp.Visible = True
    Set xlWB1 = xlApp.Workbooks.Open("Y:\Documents\Freelance\Cape Classics\v3\Profit loss Flow.xls")
    Set xlSheet = xlWB1.Worksheets("Sheet1")
 
    'print the limit titles to the data
    xlSheet.Cells(1, 2).Value = Territory
    xlSheet.Cells(2, 2).Value = Brand
    xlSheet.Cells(3, 2).Value = State
    xlSheet.Cells(1, 10).Value = firstmonth
    xlSheet.Cells(2, 10).Value = DateAdd("m", 12, firstmonth)  '!!!!!!Return last month from query
 
    'print Query Data
    currentmonth = firstmonth
    y = 5
    x = 3
    If rs.Fields("Year-Month").Value = currentmonth Then
            xlSheet.Cells(y, x).Value = currentmonth
            x = x + 1
    End If
    'Do While Not .EOF Or x <> 15
         'process Records within Loop
 
     '    .MoveNext
    'Loop
 
    'Save
    xlApp.ActiveWorkbook.SaveAs ("Y:\Documents\Freelance\Cape Classics\v3\Profit loss Flow_new.xls")
    'Clean Up
    xlWB1.Close
    Set xlWB1 = Nothing
    xlApp.Quit
    Set xlApp = Nothing
 
    PrintSheet = True
 
    rs.Close
    Set rs = Nothing
End Function
 

[ADezii]

[quote=kirschey;3479523] @ADezii
I double checked the code using Wildcards as in your case, and it still functions normally.

I still don't get how I would adapt my form inputs into the For loop.

You need not adapt anything, since the Loop evaluates to:

For Each prm In qdf.Parameters
  prm.Value = Eval(Forms!sort.territory)              'Parameter 1
  prm.Value = Eval(Forms!sort.state)                  'Parameter 2
  prm.Value = Eval(Forms!sort.brand)                 'Parameter 3
Next

[kirschey]

I commented out

     'Query Parameters
     qdf.Parameters("Region") = Me.Territory
     qdf.Parameters("State") = Me.State
     qdf.Parameters("Brand") = Me.Brand
 

and am now getting a type mismatch. Any ideas why?

[ADezii]

@kirschey

1. Your Parameters are all wrong, for instance, the State Parameter would be:
   

   Forms!sort.state

2. Run the following code within the Context of the Form to see your Parameter Names, and their corresponding Values:
   

   Dim qdf As DAO.QueryDef
   Dim db As DAO.Database
   Dim prm As DAO.Parameter
   Dim stDocName As String
    
   stDocName = "<Query Name Here>"
    
   Set db = CurrentDb()
   Set qdf = db.QueryDefs(stDocName)
    
   'Resolve the Parameters
   For Each prm In qdf.Parameters
     prm.Value = Eval(prm.Name)
     Msgbox prm.Name & " ==> " & prm.Value
   Next