Problem with code to edit existing data on Access database

[VISHAL120]

Greetings Gurus,

Am actually using the below code to save data to Microsoft access from VBA Excel.

Sub Update_My_DataAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
    ' connect to the Access database
    Set cn = New ADODB.Connection
    
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
        "Data Source=C:\Karina_Int\Database\Sample_Process.accdb;"
    ' open a recordset
    Set rs = New ADODB.Recordset
    


                    
    
    
    rs.Open "Tbl_Sample_details", cn, adOpenKeyset, adLockOptimistic, adCmdTable
    ' all records in a table
    r = 4 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("Ref_Client") = Range("A" & r).Value
            .Fields("Ref_Karina") = Range("B" & r).Value
            .Fields("Saison") = Range("C" & r).Value
            .Fields("Marketing_Manager") = Range("D" & r).Value
            .Fields("Merchandiser") = Range("E" & r).Value
            .Fields("Client") = Range("F" & r).Value
            .Fields("Depart") = Range("G" & r).Value
            .Fields("Theme") = Range("H" & r).Value
            .Fields("Desc") = Range("I" & r).Value
            .Fields("Type_Echantillion") = Range("J" & r).Value
            .Fields("Taille") = Range("K" & r).Value
            .Fields("Qty") = Range("L" & r).Value
            .Fields("Keep_KI") = Range("M" & r).Value
            .Fields("Type_Lavage") = Range("N" & r).Value
            .Fields("Colori_Gmt_dyed") = Range("M" & r).Value
            .Fields("Valeur_Ajouter") = Range("N" & r).Value
            '.Fields("Date_request_Merc") = Range("O" & r).Value
            '.Fields("Date_Livraison") = Range("O" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

The problem am having every time I am making a change on the data it is being save as a new data instead of updating the existing one.

Below is example of the data that has been saved twice instead of updating the existing one: Sample ID from 192 to 195 are new data save with an update made on column Ref_Karina.

Sample_id	Ref_Client	Ref_Karina	Saison	Marketing_Manager	Merchandiser	Client	Depart	Theme	Desc	Type_Echantillion	Taille	Qty	Keep_KI	Type_Lavage	Colori_Gmt_Dyed	Valeur_Ajouter	Date_request_Merc	Date_Livraison
183	TM 049-		HIV 15/16	AAA1	BCCC1	TISHOP	KIDS	CEREMONIE	SHORT	COMMANDE	2	25	1	N/A	1	N/A
184	EUROPE RK 5444 S		ETE 16	AAA2	BCCC2	TIA	KIDS	N/A	SHORT	TDS	2	1	1	N/A	1	N/A
185	ELSY RK 5461 S		ETE 16	AAA3	BCCC3	TIA	KIDS	N/A	SHORT	SEALED SAMPLE	2	1	1	N/A	1	N/A
186	ELNA RK 5460 S		ETE 16	AAA4	BCCC4	TIA	KIDS	N/A	SHORT	TDS	2	3	1	N/A	1	N/A
187	ENORA RK 5449 S		ETE 16	AAA5	BCCC5	TIA	KIDS	N/A	SHORT	SEALED SAMPLE	2	1	1	N/A	1	N/A
188	ELIA RK 5448 S		ETE 16	AAA6	BCCC6	TIA	KIDS	N/A	SHORT	SEALED SAMPLE	2	1	1	N/A	1	N/A
189	RK 4037 S		ETE 16	AAA7	BCCC7	BACKWALODGE	KIDS	RECEPTIONIST	SHORT	COMMANDE	2	42	1	N/A	1	N/A
190	CATIA RK 5511 S		HIV 15/16	AAA8	BCCC8	TIA	KIDS	N/A	SHORT	PPS	2	1	1	N/A	1	N/A
191	ELOISE RK 5441 S		ETE 16	AAA9	BCCC9	TIA	KIDS	N/A	SHORT	SEALED SAMPLE	2	1	1	N/A	1	N/A
192	TM 049-	test01	HIV 15/16	AAA1	BCCC1	TISHOP	KIDS	CEREMONIE	SHORT	COMMANDE	2	25	1	N/A	1	N/A
193	EUROPE RK 5444 S	test02	ETE 16	AAA2	BCCC2	TIA	KIDS	N/A	SHORT	TDS	2	1	1	N/A	1	N/A
194	ELSY RK 5461 S	test03	ETE 16	AAA3	BCCC3	TIA	KIDS	N/A	SHORT	SEALED SAMPLE	s	1	1	N/A	1	N/A
195	ELNA RK 5460 S	test04	ETE 16	AAA4	BCCC4	TIA	KIDS	N/A	SHORT	TDS	s	3	1	N/A	1	N/A

i would be very grateful if i can be guided on how to proceed with the coding.

many thanks.

[SamT]

First retrieve the record by Ref_Client. IF it exists, then Modify that record, Else Add New.

[VISHAL120]

Hi SamT,

This what i have been searching since days and i have not been able to figure out. If can just give some hints as example it will be of great help for me. And still googling on that since the morning and still is.

Many thanks for the kind reply.

[JKwan]

untested, but the idea is in the comment

Sub Update_My_DataAccess()
    ' exports data from the active worksheet to a table in an Access database
    ' this procedure must be edited before use
    Dim sSQL As String
    Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
    ' connect to the Access database
    Set cn = New ADODB.Connection
    
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
    "Data Source=C:\Karina_Int\Database\Sample_Process.accdb;"
    
    ' open a recordset
    Set rs = New ADODB.Recordset
    
    
'    Northwind.mdb
    
    
    
'    rs.Open "Select * From Tbl_Sample_details Where [Ref_Client] = 'xxx'", _
            cn, adOpenKeyset, adLockOptimistic, adCmdTable
    sSQL = "Select * From Tbl_Sample_details Where [Ref_Client] = 'zzz'"
    rs.Open sSQL, cn, adOpenKeyset, adLockOptimistic
    
    'rs.Open sSQL, cn, adOpenDynamic, adLockOptimistic
    ' all records in a table
    r = 4 ' the start row in the worksheet
    If rs.EOF Then ' Add your new record here
        Do While Len(Range("A" & r).Formula) > 0
            ' repeat until first empty cell in column A
            With rs
                .AddNew ' create a new record
                ' add values to each field in the record
                .Fields("Ref_Client") = Range("A" & r).Value
                .Fields("Ref_Karina") = Range("B" & r).Value
                .Fields("Saison") = Range("C" & r).Value
                .Fields("Marketing_Manager") = Range("D" & r).Value
                .Fields("Merchandiser") = Range("E" & r).Value
                .Fields("Client") = Range("F" & r).Value
                .Fields("Depart") = Range("G" & r).Value
                .Fields("Theme") = Range("H" & r).Value
                .Fields("Desc") = Range("I" & r).Value
                .Fields("Type_Echantillion") = Range("J" & r).Value
                .Fields("Taille") = Range("K" & r).Value
                .Fields("Qty") = Range("L" & r).Value
                .Fields("Keep_KI") = Range("M" & r).Value
                .Fields("Type_Lavage") = Range("N" & r).Value
                .Fields("Colori_Gmt_dyed") = Range("M" & r).Value
                .Fields("Valeur_Ajouter") = Range("N" & r).Value
                '.Fields("Date_request_Merc") = Range("O" & r).Value
                '.Fields("Date_Livraison") = Range("O" & r).Value
                ' add more fields if necessary...
                .Update ' stores the new record
            End With
            r = r + 1 ' next row
        Loop
    Else
        ' do your update here
    End If
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

[VISHAL120]

HI ,

I have been able to to manupulate a bit the code an is still lacking behind. I am having error of of snytax error ( missing operator) in query expression at the following code:

rst.Open sSQL, ActiveConnection:=cnn, _
CursorType:=adOpenKeyset, LockType:=adLockOptimistic

Please find below the complete code :

Sub update_my_data()




Application.ScreenUpdating = False    ' Prevents screen refreshing.


Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim fld As ADODB.Field
Dim MyConn
Dim lngRow As Long
Dim lngID, LR, Upd
Dim j As Long
Dim sSQL As String


LR = Range("A" & Rows.Count).End(xlUp).Row
Upd = LR - 1


lngRow = 4
Do While lngRow <= LR




lngID = Cells(lngRow, 1).Value


'sSQL = "SELECT * FROM tblPopulation WHERE (((tblPopulation.[PopID])=" & "'" & lngID & "'" & "));"
sSQL = "SELECT * FROM Tbl_Sample_details WHERE Sample_Auto_ref = " & lngID




Set cnn = New ADODB.Connection
'MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
MyConn = "Provider = Microsoft.ACE.OLEDB.12.0;" & _
"Data Source = C:\Karina_Int\Database\Sample_Process.accdb"
With cnn
' .Provider = "Microsoft.Jet.OLEDB.4.0"
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open MyConn


End With


Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
rst.Open sSQL, ActiveConnection:=cnn, _
CursorType:=adOpenKeyset, LockType:=adLockOptimistic






'Load all records from Excel to Access.


' rst(Cells(1, j).Value) = Cells(lngRow, j).Value
'Next j
With rst
'.Fields("PO") = Cells(lngRow, 1).Value
'.Fields("Country") = Cells(lngRow, 2).Value
            .Fields("Sample_Auto_ref") = Range("A" & r).Value
            .Fields("Ref_Client") = Range("B" & r).Value
            .Fields("Ref_Karina") = Range("C" & r).Value
            .Fields("Saison") = Range("D" & r).Value
            .Fields("Marketing_Manager") = Range("E" & r).Value
            .Fields("Merchandiser") = Range("F" & r).Value
            .Fields("Client") = Range("G" & r).Value
            .Fields("Depart") = Range("H" & r).Value
            .Fields("Theme") = Range("I" & r).Value
            .Fields("Desc") = Range("J" & r).Value
            .Fields("Type_Echantillion") = Range("K" & r).Value
            .Fields("Taille") = Range("L" & r).Value
            .Fields("Qty") = Range("M" & r).Value
            .Fields("Keep_KI") = Range("N" & r).Value
            .Fields("Type_Lavage") = Range("O" & r).Value
            .Fields("Colori_Gmt_dyed") = Range("P" & r).Value
            .Fields("Valeur_Ajouter") = Range("Q" & r).Value
            .Fields("Date_request_Merc") = Range("R" & r).Value
            .Fields("Date_Livraison") = Range("S" & r).Value


rst.Update
End With


' Close the connection
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing


lngRow = lngRow + 1


Loop
MsgBox "You just updated " & Upd & " records"
End Sub

Am also attaching the file and the database for a better idea. As before updating normally it shall check if data exist if not exist then add new and if exist then update all the existing records with the last modification done on any column or rows. Actually i have put the add new in a separate code.

I have been searching and working on that till days but is still figuring out as this is the main part of the project for all data to be updated and which are later analyse and reporting.

please i just need some tips and hints on that so as to complete the project in time.

many thanks for the kind understanding.

[JKwan]

update your sSQL to this, you missed the single quote around your lngID

sSQL = "SELECT * FROM Tbl_Sample_details WHERE [Sample_Auto_ref] = '" & lngID & "'"

[VISHAL120]

Hello Everyone,

I have been able to work out some of the code as follows for adding, updating,downloading from database.

But the main problem am facing actually is data duplication both when adding the record to the database and when downloading the record from database to excel.

I have been googling since days to find solutions for the problem on how to check if the data already exits but till now have not find the solution. I will humbly request a great advise and help on that please.

this is code am using for adding data to the database:

Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
    ' connect to the Access database
    Set cn = New ADODB.Connection
    'cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=C:\FolderName\DataBaseName.mdb;"
        'cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;"
        
        'office Connection
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
        "Data Source=C:\Karina_Int\Database\Sample_Process.accdb;"
        
       ' home Connection
        'cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
        "Data Source=E:\Karina_Int\Database\Sample_Process.accdb"
    ' open a recordset
    Set rs = New ADODB.Recordset
   
    rs.Open "Tbl_Sample_details", cn, adOpenKeyset, adLockOptimistic, adCmdTable
    ' all records in a table
    r = 4 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("Sample_Auto_ref") = Range("A" & r).Value
            .Fields("Ref_Client") = Range("B" & r).Value
            .Fields("Ref_Karina") = Range("C" & r).Value
            .Fields("Saison") = Range("D" & r).Value
            .Fields("Marketing_Manager") = Range("E" & r).Value
            .Fields("Merchandiser") = Range("F" & r).Value
            .Fields("Client") = Range("G" & r).Value
            .Fields("Depart") = Range("H" & r).Value
            .Fields("Theme") = Range("I" & r).Value
            .Fields("Desc") = Range("J" & r).Value
            .Fields("Type_Echantillion") = Range("K" & r).Value
            .Fields("Taille") = Range("L" & r).Value
            .Fields("Qty") = Range("M" & r).Value
            .Fields("Keep_KI") = Range("N" & r).Value
            .Fields("Type_Lavage") = Range("O" & r).Value
            .Fields("Colori_Gmt_dyed") = Range("P" & r).Value
            .Fields("Valeur_Ajouter") = Range("Q" & r).Value
            .Fields("Date_request_Merc") = Range("R" & r).Value
            .Fields("Date_Livraison") = Range("S" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

The update code is separated as i have not been able to put the add new and update code together ( if this also can be ameliorate will be better for me )which is as follows:

Sub update_my_data()




Application.ScreenUpdating = False    ' Prevents screen refreshing.


Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim fld As ADODB.Field
Dim MyConn
Dim lngRow As Long
Dim lngID, LR, Upd
Dim j As Long
Dim sSQL As String


LR = Range("A" & Rows.Count).End(xlUp).Row
Upd = LR - 1


lngRow = 4
Do While lngRow <= LR




lngID = Cells(lngRow, 1).Value


'sSQL = "SELECT * FROM tblPopulation WHERE (((tblPopulation.[PopID])=" & "'" & lngID & "'" & "));"
sSQL = "SELECT * FROM Tbl_Sample_details WHERE Sample_Auto_ref = '" & lngID & "'"


'sSQL = "SELECT * FROM Tbl_Sample_details WHERE [Sample_Auto_ref] = '" & lngID & "'"
Set cnn = New ADODB.Connection
'MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB


'Office Connection:


MyConn = "Provider = Microsoft.ACE.OLEDB.12.0;" & _
"Data Source = C:\Karina_Int\Database\Sample_Process.accdb"


'Home Connection:
'MyConn = "Provider = Microsoft.ACE.OLEDB.12.0;" & _
"Data Source = E:\Karina_Int\Database\Sample_Process.accdb"




With cnn
' .Provider = "Microsoft.Jet.OLEDB.4.0"
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open MyConn


End With


Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
rst.Open sSQL, ActiveConnection:=cnn, _
CursorType:=adOpenKeyset, LockType:=adLockOptimistic






'Load all records from Excel to Access.


' rst(Cells(1, j).Value) = Cells(lngRow, j).Value
'Next j
With rst
If .BOF = True And .EOF = True Then
Debug.Print "No existing record - adding new..."


MsgBox "No records in recordset."
Exit Sub
End If
'.Fields("PO") = Cells(lngRow, 1).Value
'.Fields("Country") = Cells(lngRow, 2).Value
            .Fields("Sample_Auto_ref") = Cells(lngRow, 1).Value
            .Fields("Ref_Client") = Cells(lngRow, 2).Value
            .Fields("Ref_Karina") = Cells(lngRow, 3).Value
            .Fields("Saison") = Cells(lngRow, 4).Value
            .Fields("Marketing_Manager") = Cells(lngRow, 5).Value
            .Fields("Merchandiser") = Cells(lngRow, 6).Value
            .Fields("Client") = Cells(lngRow, 7).Value
            .Fields("Depart") = Cells(lngRow, 8).Value
            .Fields("Theme") = Cells(lngRow, 9).Value
            .Fields("Desc") = Cells(lngRow, 10).Value
            .Fields("Type_Echantillion") = Cells(lngRow, 11).Value
            .Fields("Taille") = Cells(lngRow, 12).Value
            .Fields("Qty") = Cells(lngRow, 13).Value
            .Fields("Keep_KI") = Cells(lngRow, 14).Value
            .Fields("Type_Lavage") = Cells(lngRow, 15).Value
            .Fields("Colori_Gmt_dyed") = Cells(lngRow, 16).Value
            .Fields("Valeur_Ajouter") = Cells(lngRow, 17).Value
            .Fields("Date_request_Merc") = Cells(lngRow, 18).Value
            .Fields("Date_Livraison") = Cells(lngRow, 19).Value




rst.Update
End With


' Close the connection
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing


lngRow = lngRow + 1


Loop
MsgBox "You just updated " & Upd & " records"
'Debug.Print "You just updated " & Upd & " records"
End Sub

This is the code being use to download the data to excel and having problem of duplication:

Sub Download_data_From_Dase()
 
 
          Dim cn As Object, rs As Object
          Dim intColIndex As Integer
          Dim DBFullName As String
          Dim TargetRange As Range
          Dim LR
        'HOME CONNECTION
        'DBFullName = "E:\Karina_Int\Database\Sample_Process.accdb"
        'OFFICE CONNECTION
        DBFullName = "C:\Karina_Int\Database\Sample_Process.accdb"
       'On Error GoTo Whoa


        Application.ScreenUpdating = False
        Sheets("RECALL").Activate
        
        'Set TargetRange = Sheets("RECALL").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        Set TargetRange = Sheets("RECALL").Cells(Rows.Count, "A").End(xlUp)
        'Set TargetRange = Sheets("RECALL").Range("A" & Rows.Count).End(xlUp).Row


        Set cn = CreateObject("ADODB.Connection")
       cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & DBFullName & ";"




Set rs = CreateObject("ADODB.Recordset")
        rs.Open "SELECT Sample_Auto_ref , Ref_Client, Ref_Karina, Saison, Marketing_Manager, Merchandiser, Client, Depart, Theme, Desc, Type_Echantillion FROM tbl_sample_details WHERE Valeur_Ajouter = 'NS'", cn, , , adCmdText
            


            
'          ' Write the field names
        For intColIndex = 0 To rs.Fields.Count - 1
           TargetRange.Offset(1, intColIndex).Value = rs.Fields(intColIndex).Name
       Next


          ' Write recordset
       TargetRange.Offset(1, 0).CopyFromRecordset rs


LetsContinue:
       Application.ScreenUpdating = True
       On Error Resume Next
       rs.Close
      Set rs = Nothing
       cn.Close
       Set cn = Nothing
       On Error GoTo 0
       Exit Sub


End Sub

am also attaching the file and database as reference. The recall is place for test on this file as it suppose to be in another workbook.



thanking in advance for the help and guidance for the above as its after a lot of searching i have been able to work out the above code but is still lacking behind due to the data duplication problem.

[VISHAL120]

Hi,

I have been able to work the code for add new and update records and checking the record duplication which is as below :

Sub Add_Update_Data_To_Base()


Application.ScreenUpdating = False    ' Prevents screen refreshing.


Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim fld As ADODB.Field
Dim MyConn
Dim lngRow As Long
Dim lngId, LR, Upd
Dim j As Long
Dim sSQL As String


LR = Range("A" & Rows.Count).End(xlUp).Row
Upd = LR - 1


lngRow = 4
Do While lngRow <= LR


Sheets("marketing").Activate
lngId = Cells(lngRow, 1).Value




sSQL = "SELECT * FROM Tbl_Sample_details WHERE Sample_Auto_ref = '" & lngId & "'"




Set cnn = New ADODB.Connection




'Office Connection:


MyConn = "Provider = Microsoft.ACE.OLEDB.12.0;" & _
"Data Source = C:\Karina_Int\Database\Sample_Process.accdb"


'Home Connection:
'MyConn = "Provider = Microsoft.ACE.OLEDB.12.0;" & _
"Data Source = E:\Karina_Int\Database\Sample_Process.accdb"




With cnn
' .Provider = "Microsoft.Jet.OLEDB.4.0"
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open MyConn


End With


Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
rst.Open sSQL, ActiveConnection:=cnn, _
CursorType:=adOpenKeyset, LockType:=adLockOptimistic


'  If rs.BOF And rs.EOF Then
'    MsgBox "recordset is empty"
'Else
'    rs.MoveLast
'    MsgBox "recordset contains " & rs.RecordCount & " rows"
'End If
            
'   Set rs = Me.Recordset.Clone
'If Me.Recordset.RecordCount = 0 Then 'checks for number of records
'   MsgBox "There is no records"
'End If




            
            With rst
            'If Not (.BOF And .EOF) = True Then
            If .RecordCount = 0 Then
                      .AddNew
                        .Fields("Sample_Auto_ref") = Cells(lngRow, 1).Value
                        .Fields("Ref_Client") = Cells(lngRow, 2).Value
                        .Fields("Ref_Karina") = Cells(lngRow, 3).Value
                        .Fields("Saison") = Cells(lngRow, 4).Value
                        .Fields("Marketing_Manager") = Cells(lngRow, 5).Value
                        .Fields("Merchandiser") = Cells(lngRow, 6).Value
                        .Fields("Client") = Cells(lngRow, 7).Value
                        .Fields("Depart") = Cells(lngRow, 8).Value
                        .Fields("Theme") = Cells(lngRow, 9).Value
                        .Fields("Desc") = Cells(lngRow, 10).Value
                        .Fields("Type_Echantillion") = Cells(lngRow, 11).Value
                        .Fields("Taille") = Cells(lngRow, 12).Value
                        .Fields("Qty") = Cells(lngRow, 13).Value
                        .Fields("Keep_KI") = Cells(lngRow, 14).Value
                        .Fields("Type_Lavage") = Cells(lngRow, 15).Value
                        .Fields("Colori_Gmt_dyed") = Cells(lngRow, 16).Value
                        .Fields("Valeur_Ajouter") = Cells(lngRow, 17).Value
                        .Fields("Date_request_Merc") = Cells(lngRow, 18).Value
                        .Fields("Date_Livraison") = Cells(lngRow, 19).Value
                       .Update
                    'MsgBox "record added new"
                Else
                     
                        .Fields("Sample_Auto_ref") = Cells(lngRow, 1).Value
                        .Fields("Ref_Client") = Cells(lngRow, 2).Value
                        .Fields("Ref_Karina") = Cells(lngRow, 3).Value
                        .Fields("Saison") = Cells(lngRow, 4).Value
                        .Fields("Marketing_Manager") = Cells(lngRow, 5).Value
                        .Fields("Merchandiser") = Cells(lngRow, 6).Value
                        .Fields("Client") = Cells(lngRow, 7).Value
                        .Fields("Depart") = Cells(lngRow, 8).Value
                        .Fields("Theme") = Cells(lngRow, 9).Value
                        .Fields("Desc") = Cells(lngRow, 10).Value
                        .Fields("Type_Echantillion") = Cells(lngRow, 11).Value
                        .Fields("Taille") = Cells(lngRow, 12).Value
                        .Fields("Qty") = Cells(lngRow, 13).Value
                        .Fields("Keep_KI") = Cells(lngRow, 14).Value
                        .Fields("Type_Lavage") = Cells(lngRow, 15).Value
                        .Fields("Colori_Gmt_dyed") = Cells(lngRow, 16).Value
                        .Fields("Valeur_Ajouter") = Cells(lngRow, 17).Value
                        .Fields("Date_request_Merc") = Cells(lngRow, 18).Value
                        .Fields("Date_Livraison") = Cells(lngRow, 19).Value
                    rst.Update
            
            
            
                'MsgBox "update me"
                End If
            End With
'rst.Close 'the connection
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing


lngRow = lngRow + 1


Loop
MsgBox "You just updated " & Upd & " records"
End Sub

But am still looking for solution for the download record code from access. In fact the workbook already have some data in it and it just need to update the some of the records from the database which were changed.

the code is as such :

Sub Download_data_From_Dase()
 
 
          Dim cn As Object, rs As Object
          Dim intColIndex As Integer
          Dim DBFullName As String
          Dim TargetRange As Range
          Dim LR
        'HOME CONNECTION
        'DBFullName = "E:\Karina_Int\Database\Sample_Process.accdb"
        'OFFICE CONNECTION
        DBFullName = "C:\Karina_Int\Database\Sample_Process.accdb"
       'On Error GoTo Whoa


        Application.ScreenUpdating = False
        Sheets("RECALL").Activate
        
        'Set TargetRange = Sheets("RECALL").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        Set TargetRange = Sheets("RECALL").Cells(Rows.Count, "A").End(xlUp)
        'Set TargetRange = Sheets("RECALL").Range("A" & Rows.Count).End(xlUp).Row


        Set cn = CreateObject("ADODB.Connection")
       cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & DBFullName & ";"




Set rs = CreateObject("ADODB.Recordset")
        rs.Open "SELECT Sample_Auto_ref , Ref_Client, Ref_Karina, Saison, Marketing_Manager, Merchandiser, Client, Depart, Theme, Desc, Type_Echantillion FROM tbl_sample_details WHERE Valeur_Ajouter = 'NS'", cn, , , adCmdText
            
            
            
            
'strSQL1 = "SELECT Customers.Company, Customers.[Last Name], "
'strSQL1 = strSQL1& "Customers.[First Name], "
'strSQL1 = strSQL1& "Customers.[Job Title], Customers.[Business Phone]"
'strSQL1 = strSQL1& "FROM Customers;"
            
'          ' Write the field names
        For intColIndex = 0 To rs.Fields.Count - 1
           TargetRange.Offset(1, intColIndex).Value = rs.Fields(intColIndex).Name
       Next


          ' Write recordset
       TargetRange.Offset(1, 0).CopyFromRecordset rs


LetsContinue:
       Application.ScreenUpdating = True
       On Error Resume Next
       rs.Close
      Set rs = Nothing
       cn.Close
       Set cn = Nothing
       On Error GoTo 0
       Exit Sub


End Sub