Excel passing parameters to Access for queries

[RichardMGreen]

Hi all

I've got a piece of code in Excel which links to an Access database and runs queries in it.
Some of the queries need parameters which are being passed to it using this piece of code:-

If param1 <> "" Then cmd.Parameters(0) = param1

The query I'm running requires 1 parameter which is contained in param1 (and I've stepped through the code to make sure it's there).

When I try to pass the parameter, I get the following error message and the code stops:-
Item cannot be found in the collection corresponding to the requested name or ordinal

If I miss out the the line of code above (leaving the parameter empty) and try to execute the query, I get the following error message:-
Too few parameters. Expected 1

It looks like I need to pass the parameter, but when I do it isn't accepted.

Anyone any ideas?

 

[RoryA]

What's the full code? Are you refreshing the parameters first?

 

[RichardMGreen]

This is the full piece of code from Excel:-

Option Explicit
Public conn As ADODB.Connection, rs As ADODB.Recordset, cmd As ADODB.Command
Public wb As Workbook, twb As Workbook
Public querydata As Worksheet, wsDst As Worksheet, ws As Worksheet, member_sheet As Worksheet
Public rngData As Range, rngDst As Range, member_list As Range
Public cancel_button As Boolean, ok_button As Boolean
Public db_pass As String, strQry As String, strSQL As String, file As String, strConn As String
Public savename As String, reportingdate As String, outputlocation As String
Public maxquery As Integer, currentquery As Integer, vsion As Integer, lastrow As Integer
Public current_lastrow As Integer, counter As Integer, page_count As Integer
Public total_max_progress As Integer, total_progress As Integer
Public member_max_progress As Integer, member_progress As Integer
Public param1, param2, response
Sub Import_data()
    Set twb = ThisWorkbook
'----- Get database password or cancel if required -----
    UserForm2.Show
    If cancel_button Then Exit Sub
'----- Set up connection to database -----
    On Error GoTo db_pass_error
'----- Start setting up objects and set up database name/location and open database connection -----
    total_max_progress = 0
    total_progress = 0
    member_max_progress = 0
    member_progress = 0
    Set querydata = Worksheets("Query_List")
    Set rngData = querydata.Range("A2")
    Set member_sheet = Worksheets("Member_sheet")
    Set member_list = member_sheet.Range("A3")
    Set conn = New ADODB.Connection
    Set cmd = New ADODB.Command
    file = querydata.Range("H2")
    strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & file & _
        ";Jet OLEDB:Database Password=" & db_pass & ";"
    conn.ConnectionString = strConn
    conn.Open
    On Error GoTo 0
'----- Set up parameters for userforms and display them -----
    With UserForm1
        .Top = Application.Top + 175
        .Left = Application.Left + 250
        .ProgressBar1.Value = 0
    End With
    With UserForm3
        .Top = Application.Top + 300
        .Left = Application.Left + 250
        .ProgressBar1.Value = 0
    End With
    UserForm1.Show
'----- Get list of members -----
    Call get_member_list
'----- Get member data and produce reports -----
    UserForm3.Show
    While member_list <> ""
        Call get_member_data
        Set member_list = member_list.Offset(1)
    Wend
'----- Destroy database connection and remove userforms -----
    Set conn = Nothing
    Unload UserForm3
    Unload UserForm1
    Application.ScreenUpdating = True
    Exit Sub
db_pass_error:
    response = MsgBox("Incorrect password for this database" & vbCrLf & _
        "Please contact your administrator", vbOKOnly, "XXX INCORRECT PASSWORD XXX")
    Application.CalculateBeforeSave = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
Sub get_member_list()
'----- Turn off calculations and screen flicker -----
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
'----- Clear out old data and set up userform -----
    member_sheet.Rows("3:10000").ClearContents
    querydata.Select
'----- Get member list -----
    UserForm1.Label1.Caption = "Retrieving member list..."
    On Error GoTo 0
    While rngData.Value <> ""
        UserForm1.Label1.Caption = "Refreshing " & rngData.Value
        UserForm1.Repaint
        strQry = "[" & rngData.Value & "]"
        param1 = rngData.Offset(, 3).Value
        strSQL = "SELECT * FROM " & strQry
        cmd.CommandType = adCmdText
        cmd.CommandText = strSQL
        cmd.ActiveConnection = conn
'----- Pass parameters if needed/available -----
        If param1 <> "" Then cmd.Parameters(0) = param1
'----- Pick up information on where data is to go -----
        Set wsDst = Worksheets(rngData.Offset(, 1).Value)
        Set rngDst = wsDst.Range(rngData.Offset(, 2).Value)
'----- Retrieve data from database and insert into correct cells -----
        Set rs = cmd.Execute
        rngDst.CopyFromRecordset rs
'----- Make sure no data left to write and set up details for next query -----
        Set rs = Nothing
        Set rngData = rngData.Offset(1)
        UserForm1.Repaint
    Wend
    total_max_progress = member_sheet.Range("A65535").End(xlUp).Row + 1
    member_max_progress = querydata.Range("A65535").End(xlUp).Row - 4
    total_progress = total_progress + 1
    UserForm1.ProgressBar1.Value = (total_progress / total_max_progress) * 100
    UserForm1.Repaint
    Application.Calculate
End Sub
Sub get_member_data()
'----- Reset progress bar for new user -----
    member_progress = 0
'----- Clear out data from previous member -----
    For Each ws In Worksheets
        If InStr(ws.Name, "Raw_Data") > 0 Then
            ws.Rows("3:10000").ClearContents
        End If
    Next
'----- start running queries -----
    Set rngData = querydata.Range("A5")
    While rngData.Value <> ""
        UserForm1.Label1.Caption = "Refreshing data for " & member_list.Value
        UserForm1.Repaint
        UserForm3.Label1.Caption = "Refreshing " & rngData.Value
        UserForm3.Repaint
        strQry = "[" & rngData.Value & "]"
        param1 = member_list.Value
        strSQL = "SELECT * FROM " & strQry
        cmd.CommandType = adCmdText
        cmd.CommandText = strSQL
        cmd.ActiveConnection = conn
'----- Pass parameters if needed/available -----
        If param1 <> "" Then cmd.Parameters(0) = param1
'----- Pick up information on where data is to go -----
        Set wsDst = Worksheets(rngData.Offset(, 1).Value)
        Set rngDst = wsDst.Range(rngData.Offset(, 2).Value)
'----- Retrieve data from database and insert into correct cells -----
        Set rs = cmd.Execute
        rngDst.CopyFromRecordset rs
'----- Make sure no data left to write and set up details for next query -----
        Set rs = Nothing
        Set rngData = rngData.Offset(1)
'----- Update member progress userform -----
        member_progress = member_progress + 1
        UserForm3.ProgressBar1.Value = (member_progress / member_max_progress) * 100
        UserForm3.Repaint
    Wend
    Call formula_adjust
    Call Update_Footer
    Call save_file
'----- Update overall progress userform -----
    total_progress = total_progress + 1
    UserForm1.ProgressBar1.Value = (total_progress / total_max_progress) * 100
    UserForm1.Repaint
End Sub
Sub formula_adjust()
'----- Go through each display sheet and adjust formulas to fit data returned -----
    For Each ws In Worksheets
        If InStr(ws.Name, "Raw_Data") > 0 And ws.Name <> "Front_Page_Raw_Data" Then
            If InStr(ws.Name, "Care") = 0 Then
                lastrow = ws.Range("A65535").End(xlUp).Row
                current_lastrow = Sheets(Left(ws.Name, Len(ws.Name) - 9)).Range("A65535").End(xlUp).Row
                If lastrow > 4 And current_lastrow > 9 Then
                    If current_lastrow > lastrow Then
                        Sheets(Left(ws.Name, Len(ws.Name) - 9)).Rows(lastrow + 6 & ":" & _
                            current_lastrow).Delete
                    Else
                        Sheets(Left(ws.Name, Len(ws.Name) - 9)).Rows("9:9").Copy
                        Sheets(Left(ws.Name, Len(ws.Name) - 9)).Rows("10:" & lastrow).Paste
                    End If
                End If
            End If
        End If
    Next
'----- Special loop just for Care Plan ------
    For counter = 1 To 8
        lastrow = Sheets("Care_Plan_Raw_Data").Range("A65535").Offset(0, (counter - 1) * 6).End(xlUp).Row
        current_lastrow = Sheets("Care_Plan_Pt_" & counter).Range("A65535").End(xlUp).Row
        If lastrow > 4 And current_lastrow > 9 Then
            If current_lastrow > lastrow Then
                Sheets("Care_Plan_Pt_" & counter).Rows(lastrow + 6 & ":" & current_lastrow).Delete
            Else
                Sheets("Care_Plan_Pt_" & counter).Rows("9:9").Copy
                Sheets("Care_Plan_Pt_" & counter).Rows("10:" & lastrow).Paste
            End If
        End If
    Next
End Sub
Sub Update_Footer()
    page_count = -1
    For Each ws In Worksheets
        If InStr(ws.Name, "Raw_Data") = 0 Then
            With ws.PageSetup
                .LeftFooter = "Data Extraction Date " & Sheets("Query_List").Range("H18").Value
                .CenterFooter = "C4C_ID " & Sheets("Front_Page").Range("C7").Value
                .RightFooter = "Page " & page_count & " of 12"
            End With
            page_count = page_count + 1
        End If
    Next
End Sub
Sub save_file()
'----- Add workbook ready for sheets to be copied -----
    Set wb = Workbooks.Add
'----- Copy relevant worksheets to new book -----
    twb.Sheets(Array("Front_Page", "Stage_Of_Change", "Assessments_Taken", "Care_Plan_Pt_1", _
        "Care_Plan_Pt_2", "Care_Plan_Pt_3", "Care_Plan_Pt_4", "Care_Plan_Pt_5", _
        "Care_Plan_Pt_6", "Care_Plan_Pt_7", "Care_Plan_Pt_8", "Clinical_Data")).Copy After:=wb.Sheets(3)
    Application.DisplayAlerts = False
'----- Remove original worksheets and set others to values-only -----
    With wb
        .Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
        .Colors = twb.Colors
        For Each ws In wb.Worksheets
            ws.Cells.Copy
            ws.Cells.PasteSpecial (xlPasteValues)
            ws.Select
            ws.Range("A1").Select
        Next
        wb.Sheets("Front_Page").Select
    End With
    Application.DisplayAlerts = True
'----- Set up variables for saving report -----
    reportingdate = Format(Now(), " Mmmm yyyy")
    outputlocation = querydata.Range("H10")
    savename = twb.Sheets("Front_Page").Range("C8") & " " & querydata.Range("H14")
    vsion = 1
'----- Save new workbook with version control -----
    Do While FileExists(outputlocation & savename & reportingdate & " v" & vsion & ".xls")
        vsion = vsion + 1
    Loop
    wb.SaveAs Filename:=outputlocation & savename & reportingdate & " v" & vsion & ".xls"
    wb.Close False
End Sub
Private Function FileExists(fname) As Boolean
'----- Returns TRUE if the file exists -----
    Dim x As String
    x = Dir(fname)
    If x <> "" Then FileExists = True Else FileExists = False
End Function

I've narrowed it down to 1 query in Access and the SQL for that is:-

SELECT Member_Data.[C4C-ID], Member_Data.[Date of Birth], [Care Plan Report - Member Demographics].Consented, [Care Plan Report - Member Demographics].Consent_Date, [Care Plan Report - Member Demographics].Care_Manager, Member_Data.[NHS Number], [Care Plan Report - Member Demographics].ReasonForReferral, [Care Plan Report - Member Demographics].Referral_Source, [Care Plan Report - Member Demographics].Frequency_of_Call, Member_Data.[Inactivation Date], Member_Address![First Name] & " " & Member_Address![Last Name] AS Name, Member_Address.[Address 1], Member_Address.[Address 2], Member_Address.[Address 3], Member_Address.City, [Care Plan Report - Member Demographics].Patient_Status, Member_Data.[Inactivation Reason]
FROM (Member_Data LEFT JOIN Member_Address ON Member_Data.[C4C-ID] = Member_Address.[C4C ID]) LEFT JOIN [Care Plan Report - Member Demographics] ON Member_Data.[C4C-ID] = [Care Plan Report - Member Demographics].MEMBER_C4C_ID
WHERE (((Member_Data.[C4C-ID])=[Member_ID]));

I'm going to try rebuilding the Access query from scratch and see if that makes a difference, but any other assistance would be greatly appreciated.

 

[RoryA]

I don't see any parameter declarations at the top?

 

[RichardMGreen]

Param1 and Param2 are the parameters I'm going to use (although param2 may be removed as I don't think I'll need it). They are both public.

Param1 is filled in each time the loop for member_data is gone through.

 

[RoryA]

I mean I can't see any parameters declared at the start of your Access query.

 

[RichardMGreen]

Sorry, you've lost me.
I've taken this code from on here and tried to modify it a bit.
What would the declarations look like and where would they go?

 

[RoryA]

The SQL would look like:

PARAMETERS Member_ID Long;
SELECT Table1.*
FROM Table1
WHERE (((Table1.ID)=[Member_ID]));

for example.

 

[RichardMGreen]

The query was built in Access itself using the designer. I can't post the design view so I posted the SQL.

The where section contains the parameter [Member_ID] and that was put in using designer as well.

 

[RoryA]

That means that the parameter is not explicitly declared (bad practice IMO). If you right-click in the query grid in design view and choose Parameters..., then you can declare them properly.