Updating a Access table with Data from an Excel spreadsheet using VBA

[Imo92]

Been tasked with changing some code to do a new task but unsure how to go about it as I'm pretty new to VBA.

I have an access table called Stock , with columns PartNo, Remark, ProdDesc, Price, cusDesc.
I have a excel spreadsheet with the same columns that have selected items from the Access table which have had their prices updated.

Below is code that I am trying to adapt to allow me to import updated items new prices to the table while keeping the other items intact. Currently this code overwrites the current data in the table with the data in the excel spreadsheet.

Appreciate the help.

Private Sub Command0_Click()    Dim xlApp As Object 
    Dim txt As String
    
    Const clmNoPartNo As Integer = 1
    Const clmNoRemark As Integer = 2
    Const clmNoProdDesc As Integer = 3
    Const clmNoPrice As Integer = 4
    Const clmNoCusDesc As Integer = 5
    
    Dim myRow As Long
    Dim rs As Recordset
    Dim filename As String
    Dim sql As String
    
    On Error GoTo ErrHandler
        CommonDialog1.filename = ""
        CommonDialog1.showOpen
        If Len(CommonDialog1.filename) < 3 Then Exit Sub
        Set xlApp = CreateObject("Excel.Application")
        xlApp.Workbooks.Open filename:=CommonDialog1.filename
        
        myRow = 0


        Do
           myRow = myRow + 1
        Loop Until (InStr(xlApp.Cells(myRow, 1), "MDDFieldName_Product_ID") > 0) Or (myRow > 20)
        If myRow > 20 Then
            MsgBox "Column titles not found. Please check format of pricelist."
            xlApp.Quit
            Set xlApp = Nothing
            Exit Sub
        Else
            If ((InStr(xlApp.Cells(myRow, 1), "Product_ID") > 0) And (InStr(xlApp.Cells(myRow, 1), "Product_ID") > 0) And (InStr(xlApp.Cells(myRow, 1), "Product_ID") > 0) And (InStr(xlApp.Cells(myRow, 1), "Product_ID") > 0)) Then
                'nothing
            Else
                MsgBox "Column titles not found. Please check format of pricelist."
                xlApp.Quit
                Set xlApp = Nothing
                Exit Sub
            End If
        End If
        


        '---Find First Part
        Do
           myRow = myRow + 1
        Loop While (Len(xlApp.Cells(myRow, 1)) < 2) Or (myRow > 30)
        If myRow > 30 Then
            MsgBox "No parts found. Please check format of pricelist."
            xlApp.Quit
            Set xlApp = Nothing
            Exit Sub
        End If
        




        txt = ""
        DoCmd.SetWarnings False
        DoCmd.RunSQL "delete from stock"
        DoCmd.SetWarnings True
        Set rs = CurrentDb.OpenRecordset("stock")
        Do
            i = myRow
            Form.Caption = "Importing row :" & i
            rs.AddNew
            
            rs("PartNo") = xlApp.Cells(i, clmNoPartNo)
            
            rs("Description") = Left(xlApp.Cells(i, clmNoProdDesc), 100)
            
            If Len(xlApp.Cells(i, clmNoProdDesc)) > 255 Then
                rs("LongDescription") = Left(xlApp.Cells(i, clmNoProdDesc), 255)


            Else
                rs("LongDescription") = xlApp.Cells(i, clmNoProdDesc)
            End If
            
            rs("Remarks") = Left(xlApp.Cells(i, clmNoRemark), 255)
            
            rs("UnitPrice") = xlApp.Cells(i, clmNoPrice)
            
            rs("CustomerDescription") = xlApp.Cells(i, clmNoCusDesc)
            
            rs.Update
            myRow = myRow + 1


        Loop While Len(xlApp.Cells(myRow, 1)) > 2
        
        Form.Caption = ""
        rs.Close
        MsgBox ("Done. " & i & " rows processed.")
        
        xlApp.Quit
        Set xlApp = Nothing
        'substitute short descriptions
        DoCmd.SetWarnings False
        sql = "UPDATE stock INNER JOIN [Short Descriptions] " & _
            "ON stock.PartNo = [Short Descriptions].PartNo " & _
            "SET stock.Description = [short descriptions].[description];"
        DoCmd.RunSQL sql
        DoCmd.SetWarnings True
    Exit Sub


        ErrHandler:
            MsgBox ("Import failed on row: " & i)
            Form.Caption = ""
            rs.Close
            xlApp.Quit
            Set xlApp = Nothing

        End Sub

 

[alansidman]

Instead of updating the the table, suggest you link your excel table to Access. In this manner, the db is always up to date and there is no need to run this code.

 

[xenou]

As a general rule, I'd say import the entire spreadsheet into Access as a (temp) table. Then work with access tables only. For instance, a simple update statement would be enough at that point (assuming good data and good structure in the excel workbook). You don't need to worry about updating prices that don't change (since these are updated to what they already are. But you can update only prices that are different, with a criteria of price not equal to price. You can also run a query to view the records that are changing first, in order to have some visibility on what is going to happen (and you can even save these as a audit trail in a history table).