Excel VBA Executing MS-Access Parameter Query Error

Hi,

I have Union Query in access named "Audit Query" and in this query has two parameters "Quarter" and "Last Name", I am using below code to pass the parameter to the query and then executing the query and holding the record in a recordset variable it is giving me an error message.

"Parameter object is improperly defined. Inconsistent or incomplete information was provided."

When I am running in MS-Access environment it is running fine.

Code:

---

Sub LC_Test_Kashif()

'For this to work, you must goto Tools->Reference and select "Microsoft Active X Data Objects x.xx Object Library" and "Microsoft Outlook XX.X Object Library", otherwise VBA won't recognize the code

'Bring up logic checks for individual user

'Step 1: Declare your variables
Dim UserName As String
Dim LastName As String
Dim Quarter As Date
Dim LastRow As Long
Dim strMyPath As String, strDBName As String, strDB As String
Dim rsRecSet As ADODB.Recordset
dim strCon as adodb.connection

LastRow = Cells(Rows.Count, 1).END(xlUp).Row

LastName = Range("D2").Value
Quarter = Range("B2").Value

Dim cmdl As ADODB.Command

Set strCon = New ADODB.Connection

#If Win64 Then
strCon.Open "Driver={Microsoft Access Driver (*.mdb, *.accdb)};Dbq=G:\Workflow Tools (Michael Cantor)\Tool For Fixing Bug From Michael Cantor\CDT PI Workload Report\QC Queries.mdb;Uid=Admin;Pwd="
#Else
strCon.Open "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=G:\Workflow Tools (Michael Cantor)\Tool For Fixing Bug From Michael Cantor\CDT PI Workload Report\QC Queries.mdb"
#End If

'Create a new command object to process the stored proc
Set cmdl = New ADODB.Command
Set rsRecSet = New ADODB.Recordset

With cmdl
.ActiveConnection = strCon
'set COMMAND timeout property - query can time out on either the connection OR the command
.CommandTimeout = 4000
.CommandText = "Audit Query"
.CommandType = adCmdStoredProc
.Parameters.Refresh
.Parameters.Append .CreateParameter("Quarter", adVarChar, adParamInput, 100, Quarter)
.Parameters.Append .CreateParameter("Last Name", adVarChar, adParamInput, 100, LastName)
Set rsRecSet = .Execute()                                                                                              'Error Line
End With

'Step 5: Clear previous contents
Sheets("Audits").Select
ActiveSheet.Range("A5:H1000").ClearContents

'Step 6: Copy and Sort the recordset to Excel
Sheets("Audits").Select
ActiveSheet.Range("A5:H1000").CopyFromRecordset MyRecordset


'Hide Rows
Dim c As Range
Dim LastRow1 As Long

LastRow1 = Cells(Rows.Count, 1).END(xlUp).Row

For Each c In Range("H5:H" & LastRow1).Cells
If c.Value <> "" And Range("F2").Value = "N" Then
c.EntireRow.Hidden = True

Else: c.EntireRow.Hidden = False

End If

Next c

ActiveSheet.Range("4:4").EntireRow.Hidden = False

End Sub

---

Please help me to resolve this problem this is very very urgent please

Thanks in advance

Thanks
Kashif