View Single Post
  #1 (permalink)  
Old June 28th, 2005, 08:24 AM
Raymie_C Raymie_C is offline
Authorized User
 
Join Date: Apr 2005
Location: , , .
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
Default Runtime Error 3061 - too few parameters

I am hoping someone could help. I have a database which users will access to update the status and forecast of business objectives and sub-objectives on a monthly basis.

The users will open the form which presents a parameter form based on a parameter query. The users will select the reporting month from a combobox which opens the reporting form (grouped by objective with the sub-objectives listed in a subdatasheet form for that specific month).

This works perfectly by restricting the sub-objectives by the month. The users will then update the status and forecast of these sub-objectives.

The problem arises when I go to export the status and forecasts of that specified month to a PowerPoint presentation (for reporting at our monthly management meetings) I am presented with "Error 3061 : Too few parameters.Expected 1". Sometimes this number is 2. and breaks on the line below.

Set recStatus = dbStatus.OpenRecordset(strSQL, dbOpenDynaset)

strSQL contains the code:

strSQL = "SELECT * FROM qryEnablerLookup WHERE [fkMonthID]" & " = '" & Forms!frmCriteria!cboMonth & "';"

I am at a total loss. When I go to debugging, the value being passed is correct (e.g. 1 for Jan etc).

I'm certainly not the best at SQL and vba for that matter, therefore any help would be greatly appreciated.


Thanx in advance


P.S. I've attached the complete code for the export button below.

Private Sub cmdExport_Click()

Dim dbStatus As Database
Dim recStatus As Recordset
Dim strSQL As String
Dim strStatus As String
Dim intValueStatus As Integer
Dim intValueForecast As Integer
Dim objPPApp As PowerPoint.Application
Dim objPPPres As PowerPoint.Presentation
Dim strFile As String
Dim intSOID As Integer
Dim strStatusShape As String
Dim lngSlideID As Long
Dim strStatusBox As String
Dim intEnablerID As Integer
Dim intForecastID As Integer
Dim strFace As String
Dim myDef As QueryDef


strSQL = "SELECT * FROM qryEnablerLookup WHERE [fkMonthID]" & " = '" & Forms!frmCriteria!cboMonth & "';"

strFile = "H:\PoaP.ppt"

Set dbStatus = CurrentDb
Set recStatus = dbStatus.OpenRecordset(strSQL, dbOpenDynaset)

Set objPPApp = New PowerPoint.Application
objPPApp.Visible = msoTrue
Set objPPPres = objPPApp.Presentations.Open(strFile, msoFalse)

With objPPPres

    Do While Not recStatus.EOF

        intValueStatus = recStatus.Fields("fkStatusID").Value
        intValueForecast = recStatus.Fields("fkForecastID").Value
        intSOID = recStatus.Fields("ParentID").Value
        intEnablerID = recStatus.Fields("EnablerID").Value
        intForecastID = recStatus.Fields("EnablerID").Value

        Select Case intSOID

        Case 10
            lngSlideID = 1012

        Case 20
            lngSlideID = 1017

        Case 30
            lngSlideID = 1022

        Case 40
            lngSlideID = 1028

        Case 50
            lngSlideID = 1035

        Case Else
            MsgBox "A slide does not exist for this strategic objective!"

        End Select

        .Slides.FindBySlideID(lngSlideID).Select

        Select Case intEnablerID

        Case 11
            strStatusBox = "Rectangle 56"
        Case 12
            strStatusBox = "Rectangle 129"
        Case 13
            strStatusBox = "Rectangle 145"
        Case 21
            strStatusBox = "Rectangle 101"
        Case 22
            strStatusBox = "Rectangle 109"
        End Select


        Select Case intForecastID

        Case 11
            strFace = "AutoShape 120"
        Case 12
            strFace = "AutoShape 130"
        Case 13
            strFace = "AutoShape 146"
        Case 21
            strFace = "AutoShape 102"
        Case 22
            strFace = "AutoShape 110"
        End Select



        Select Case intValueStatus

        Case 1
            objPPApp.ActiveWindow.Selection.SlideRange.Shapes( strStatusBox).Select
            With objPPApp.ActiveWindow.Selection.ShapeRange
                .Fill.Visible = msoTrue
                .Fill.Solid
                .Fill.ForeColor.RGB = RGB(0, 250, 0)
            End With
            strStatus = "Green"
            Debug.Print strStatus

        Case 2
            objPPApp.ActiveWindow.Selection.SlideRange.Shapes( strStatusBox).Select
            With objPPApp.ActiveWindow.Selection.ShapeRange
                .Fill.Visible = msoTrue
                .Fill.Solid
                .Fill.ForeColor.RGB = RGB(250, 250, 0)
            End With
            strStatus = "Amber"
            Debug.Print strStatus

        Case 3
            objPPApp.ActiveWindow.Selection.SlideRange.Shapes( strStatusBox).Select
            With objPPApp.ActiveWindow.Selection.ShapeRange
                .Fill.Visible = msoTrue
                .Fill.Solid
                .Fill.ForeColor.RGB = RGB(250, 0, 0)
            End With
            strStatus = "Red"
            Debug.Print strStatus
        Case Else
            MsgBox "Either the status/forecast of all enablers have not been set!"

        End Select


        Select Case intValueForecast

        Case 1
            objPPApp.ActiveWindow.Selection.SlideRange.Shapes( strFace).Select
            objPPApp.ActiveWindow.Selection.ShapeRange.Adjustm ents.Item(1) = 0.8111
        Case 2
            objPPApp.ActiveWindow.Selection.SlideRange.Shapes( strFace).Select
            objPPApp.ActiveWindow.Selection.ShapeRange.Adjustm ents.Item(1) = 0.7649
        Case 3
            objPPApp.ActiveWindow.Selection.SlideRange.Shapes( strFace).Select
            objPPApp.ActiveWindow.Selection.ShapeRange.Adjustm ents.Item(1) = 0.7181
        Case Else
            MsgBox "The status/forecast of all enablers have not been set!"
        End Select

    recStatus.MoveNext

    Loop


End With

recStatus.Close
objPPPres.SaveAs FileSave
objPPPres.Close
objPPApp.Quit

End Sub
Reply With Quote