Reading From Excel/CSV Fie to an Access DB

[yrstruly]

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
########
########
XXV
Test Virus X
NEG
Test sample data X
Ref_99999
S999
########

250B
NewBlockABC
########
########
PR
Test Virus PR
POS
Test sample data Y
Ref_88888
S888
########

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"

[pbaldy]

What line causes the error? What is the text of the error message?

[jojowhite]

runtime 3022 on Ms Access means you are trying to save a Primary Key that already exists (will duplicate) in the in the table.

also it would be easy if you could upload a sample .xls/.xlsx file instead.

[Welshgasman]

Why do newbies think that people that help know all the error codes to heart?

[Bulzie]

That seems awful complicated to import an excel file? I have an old program that uses a saved Import routine to do it (basically manually import the excel file one time and save the Import routine to use in code below).

' Check for file
If Dir("x:\PatientComments\DataFile\PatientComments.X lsx") = "" Then
MsgBox "The Patient Comments File does not exist, please download a current Patient Comments File and place into directory X:\PatientComments\DataFile."
DoCmd.Hourglass False
End
End If


'Import Comments from Excel file
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryDelete_Sheet1" 'Delete all records to initialize the table each run.
DoCmd.RunSavedImportExport "ImportCommentsNew" 'Imports the excel sheet to table Sheet1.
DoCmd.SetWarnings True

Once the data is in table Sheet1 you can use VBA to access the data as needed.

[pledbetter]

Why do newbies think that people that help know all the error codes to heart?

You don't? Well...

[pledbetter]

Like @jojowhite said earlier, Error 3022 means you are trying to load data into a table that has a field you have defined as indexed with no duplicates allowed. It's easy to do if you have a large dataset in your spreadsheet. First look at your destination table definition. Determine which one(s) do not allow duplicates. Then go to your Excel sheet, and for each column that corresponds to a unique field destination that cannot have duplicates, do the following:

1. Insert a new adjacent column
2. Start at Row 2
3. Create the following formula: =IF(<Column Letter>2=<Column Letter>1, "Dupe","") Example: =IF (G2=G1, "Dupe","")
4. Copy that formula and paste it all the way down to your last row.

Your duplicates will be specified and you can fix them all before you attempt a subsequent load. Do the same for any other column that will end up in an Access table field that disallows duplicates. Delete that column you just made with all your formulas first!