Updating Update Query from Excel Cell

[hilux1979]

hi, I have been stuck with this part here for days...
basically I have been trying to use VBA in excel to "export" a value as a criteria to an update query in Access. I have googled part of the solution but I got stuck with this "error 3265, item not found in this collection"

Sub importTblCurrent()
    Dim tsSH As Worksheet
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim strConn As String
    Dim strSQL As String
    Dim wkComm As Date
    Dim sDC As String
    Dim mydatabase As DAO.Database
    Dim myquerydef As DAO.QueryDef
    Dim myrecordset As DAO.Recordset
    Dim ws As DAO.Workspace
    Dim wkCommPara As Date
    'Dim i As Integer
      
    
    Set ws = DBEngine.Workspaces(0)
    Set tsSH = Sheets("Test")
    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    strConn = "C:\CasLeave.accdb"
    wkCommPara = Sheets("Test").Range("I1")
    Set mydatabase = ws.OpenDatabase _
    ("C:\CasLeave.accdb")
    Set myquerydef = mydatabase.QueryDefs("qryapplyreq")
    
    With myquerydef
    .Parameters([wkComm]) = wkCommPara
    End With
    
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & strConn & ";"
    cn.Execute "qryDelCurrent"
    cn.Execute "qryApplyMaster"
    cn.Execute "qryApplyReq"
    strSQL = "SELECT * from tblCurrent"
    
    
    rs.Open strSQL, cn
    
    Sheets("Test").Range("c6:I65000").ClearContents
    
    tsSH.Range("A6").CopyFromRecordset rs
    
    rs.Close
    cn.Close
    Set rs = Nothing
    Set con = Nothing
    MsgBox ("Casual Roster created for: " & tsSH.Range("I1").Value)
End Sub

attached with my query setup

please help? I have been stuck for days