Upload Excel File with VBA

[yrstruly]

I’ve developed a VBA upload function to allow the user to import data from an Excel file, rather than entering it manually. While the upload completes successfully, the data does not appear in any of the underlying tables.


I suspect this might be due to the upload bypassing certain key columns or relationships.
The form in question is linked to a query that joins several tables — I’ve attached the relevant tables and a sample dataset for reference. Could you please assist in tracing where the uploaded data is actually going?
https://drive.google.com/file/d/1dpi...ew?usp=sharing
https://docs.google.com/spreadsheets...f=true&sd=true
https://docs.google.com/document/d/1...f=true&sd=true

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 Row As Integer
    Dim lastRow As Integer
    Dim sqlInsert As String
    Dim recordExists 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"
        .AllowMultiSelect = False ' Ensure only one file is selected


        If .Show = -1 Then
            filePath = .SelectedItems(1) ' Get the selected file path
        Else
            MsgBox "No file selected. Operation canceled.", vbExclamation, "Upload Canceled"
            Exit Sub ' User canceled
        End If
    End With


    ' Open Excel application
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False ' Run Excel in the background
    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()


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


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


        ' Check if record exists in TblPathResults based on unique key fields
        recordExists = DCount("*", "TblPathResults", "Nr='" & xlSheet.Cells(Row, 1).Value & "' AND Block='" & xlSheet.Cells(Row, 2).Value & "' AND TestDate=#" & Format(xlSheet.Cells(Row, 4).Value, "yyyy-mm-dd") & "#")


        If recordExists = 0 Then
            ' Construct SQL Insert statement with correct formatting
            sqlInsert = "INSERT INTO TblPathResults (Nr, Block, SampleDate, TestDate, Virus, TestResult, TestComment, RefNo, DateLogged) VALUES (" & _
                "'" & xlSheet.Cells(Row, 1).Value & "', " & _
                "'" & xlSheet.Cells(Row, 2).Value & "', " & _
                IIf(IsDate(xlSheet.Cells(Row, 3).Value), "#" & Format(xlSheet.Cells(Row, 3).Value, "yyyy-mm-dd") & "#", "NULL") & ", " & _
                IIf(IsDate(xlSheet.Cells(Row, 4).Value), "#" & Format(xlSheet.Cells(Row, 4).Value, "yyyy-mm-dd") & "#", "NULL") & ", " & _
                "'" & xlSheet.Cells(Row, 5).Value & "', " & _
                "'" & Left(xlSheet.Cells(Row, 6).Value, 6) & "', " & _
                "'" & xlSheet.Cells(Row, 7).Value & "', " & _
                "'" & xlSheet.Cells(Row, 8).Value & "', " & _
                IIf(IsDate(xlSheet.Cells(Row, 9).Value), "#" & Format(xlSheet.Cells(Row, 9).Value, "yyyy-mm-dd") & "#", "NULL") & ");"


            ' Execute SQL Insert statement
            db.Execute sqlInsert, dbFailOnError
        End If
    Next Row


    ' Cleanup
    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"
End Sub

[madpiet]

For each row? Yuck. Row by row processing... <shudder>

What if you do something crazy like create a linked table to your Excel file, and then use Append with some filters and maybe Updates where necessary?