Reading From Excel/CSV File to an Access DB

I created an upload button for reading in Excel files into tables in Access. I keep on getting an error(Run time error 3022) , please assist.
Sample data:

Nr	Block	Last Sampling Date	Last Elisa Test Date	Virus	Virus Description	Test Result	Test Comment	Elisa Ref No	Sample No	Date Logged
999X	TestBlockXY	2025/03/20	2025/03/22	XXV	Test Virus X	NEG	Test sample data X	Ref_99999	S999	2025/03/22
250B	NewBlockABC	2025/03/21	2025/03/23	PR	Test Virus PR	POS	Test sample data Y	Ref_88888	S888	2025/03/24

Code:

Private Sub btnUpload_Click()
    Dim fd As Object
    Dim filePath As String
    Dim xlApp As Object
    Dim xlWorkbook As Object
    Dim xlSheet As Object
    Dim db As DAO.Database
    Dim rsPathResults As DAO.Recordset
    Dim rsBlocks As DAO.Recordset
    Dim row As Integer
    Dim lastRow As Integer

    ' Open file dialog
    Set fd = Application.FileDialog(3) ' File Picker
    With fd
        .Title = "Select Excel File"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls; *.xlsx"
        
        If .Show = -1 Then
            filePath = .SelectedItems(1) ' Get the file path
        Else
            Exit Sub ' User canceled
        End If
    End With

    ' Open Excel application
    Set xlApp = CreateObject("Excel.Application")
    Set xlWorkbook = xlApp.Workbooks.Open(filePath)
    Set xlSheet = xlWorkbook.Sheets(1) ' Assuming data is in the first sheet

    ' Open Access database connection
    Set db = CurrentDb()
    Set rsPathResults = db.OpenRecordset("TblPathResults", dbOpenDynaset)
    Set rsBlocks = db.OpenRecordset("TblBlocks", dbOpenDynaset)

    ' Find last row in Excel
    lastRow = xlSheet.Cells(xlSheet.Rows.Count, 1).End(-4162).Row

    ' Loop through each row in Excel and insert into Access tables
    For row = 2 To lastRow ' Assuming row 1 is headers

        ' First insert/update into TblBlocks (if new block exists)
        If DCount("*", "TblBlocks", "Nr='" & xlSheet.Cells(row, 1).Value & "' AND Block='" & xlSheet.Cells(row, 2).Value & "'") = 0 Then
            rsBlocks.AddNew
            rsBlocks!Nr = xlSheet.Cells(row, 1).Value
            rsBlocks!Block = xlSheet.Cells(row, 2).Value
            rsBlocks!Count = 1 ' Modify if Count needs a default value
            rsBlocks.Update
        End If

        ' Then, insert into TblPathResults
        rsPathResults.AddNew
        rsPathResults!Nr = Nz(xlSheet.Cells(row, 1).Value, "")
        rsPathResults!Block = Nz(xlSheet.Cells(row, 2).Value, "")
        
        ' Handle Date fields properly
        If IsDate(xlSheet.Cells(row, 3).Value) Then
            rsPathResults!SampleDate = CDate(xlSheet.Cells(row, 3).Value)
        Else
            rsPathResults!SampleDate = Null
        End If

        If IsDate(xlSheet.Cells(row, 4).Value) Then
            rsPathResults!TestDate = CDate(xlSheet.Cells(row, 4).Value)
        Else
            rsPathResults!TestDate = Null
        End If

        rsPathResults!Virus = Nz(xlSheet.Cells(row, 5).Value, "")

        ' Ensure TestResult fits within allowed field size
        If Len(Nz(xlSheet.Cells(row, 6).Value, "")) > 6 Then
            rsPathResults!TestResult = Left(xlSheet.Cells(row, 6).Value, 6)
        Else
            rsPathResults!TestResult = Nz(xlSheet.Cells(row, 6).Value, "")
        End If

        rsPathResults!TestComment = Nz(xlSheet.Cells(row, 7).Value, "")
        rsPathResults!RefNo = Nz(xlSheet.Cells(row, 8).Value, "")

        ' Handle DateLogged properly
        If IsDate(xlSheet.Cells(row, 9).Value) Then
            rsPathResults!DateLogged = CDate(xlSheet.Cells(row, 9).Value)
        Else
            rsPathResults!DateLogged = Null
        End If

        rsPathResults.Update

    Next row

    ' Cleanup
    rsPathResults.Close
    rsBlocks.Close
    Set rsPathResults = Nothing
    Set rsBlocks = Nothing
    Set db = Nothing

    xlWorkbook.Close False
    xlApp.Quit
    Set xlSheet = Nothing
    Set xlWorkbook = Nothing
    Set xlApp = Nothing

    ' Success message
    MsgBox "Data uploaded successfully!", vbInformation, "Upload Complete"