Create RecordSet from Form Parameters

Collapse
X
 
  • Time
  • Show
Clear All
new posts
  • kirschey
    New Member
    • Apr 2009
    • 7

    #1

    Create RecordSet from Form Parameters

    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:
    Code:
        '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
    Last edited by pbmods; Apr 8 '09, 11:31 PM. Reason: Added CODE tags.
  • ADezii
    Recognized Expert Expert
    • Apr 2006
    • 8834

    #2
    Originally posted by 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:
    Code:
        '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
    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:
    Code:
    Forms![<Your Form Name>]![<Your Field Name>]    'in 1 or more Criteria Rows
    Code:
    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

    Comment

    • kirschey
      New Member
      • Apr 2009
      • 7

      #3
      [QUOTE=ADezii;34 79511]
      Code:
      '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?

      Comment

      • kirschey
        New Member
        • Apr 2009
        • 7

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

        Comment

        • ADezii
          Recognized Expert Expert
          • Apr 2006
          • 8834

          #5
          Originally posted by kirschey
          I am still getting the error. Maybe it is from another part?
          Post the SQL for the Query.

          Comment

          • kirschey
            New Member
            • Apr 2009
            • 7

            #6
            It is ugly. I am sorry.


            This is the query "output."
            Code:
            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.

            Code:
            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

            Comment

            • ADezii
              Recognized Expert Expert
              • Apr 2006
              • 8834

              #7
              [QUOTE=kirschey; 3479523]
              Originally posted by ADezii
              Code:
              '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?
              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:
              Code:
              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

              Comment

              • kirschey
                New Member
                • Apr 2009
                • 7

                #8
                I commented out
                Code:
                     '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?

                Comment

                • ADezii
                  Recognized Expert Expert
                  • Apr 2006
                  • 8834

                  #9
                  Originally posted by kirschey
                  I commented out
                  Code:
                       '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?
                  1. Your Parameters are all wrong, for instance, the State Parameter would be:
                    Code:
                    Forms!sort.state
                  2. Run the following code within the Context of the Form to see your Parameter Names, and their corresponding Values:
                    Code:
                    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

                  Comment

                  Working...