PDA

View Full Version : Problem with code to edit existing data on Access database



VISHAL120
08-25-2015, 04:33 AM
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.


Tbl_Sample_details
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
08-25-2015, 07:22 AM
First retrieve the record by Ref_Client. IF it exists, then Modify that record, Else Add New.

VISHAL120
08-25-2015, 12:44 PM
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
08-25-2015, 01:15 PM
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
08-26-2015, 03:13 AM
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
08-26-2015, 07:45 AM
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
08-26-2015, 10:22 PM
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
08-27-2015, 03:12 AM
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