Mise à jour, insertion données depuis un fichier excel

**Titototi** · 14/04/2008, 09h35

Bonjour,

Je vous explique mon probleme. Je dois à partir d'un fichier excel, transférer ces données vers ma table access, c'est à dire si la données éxiste je mets à jour si des valeurs ont changé, et sinon je l'insére. Mon souci est de parcourir mon fichier excel et de vérifier pour chaque ligne ces conditions. Je précise que ma clé s'appel "Code_D" et c'est à partir de cette valeur que je dois faire les tests. Aprés réflexion, je pense utilisé un "recordset" mais débutant ds VB j'ai un peu de mal donc c'est pourquoi je vous sollicite. Merci d'avance

**a_paul** · 22/09/2009, 18h03

sur mon site tu un module qui le fais sur la plupart des bd.
access,dbase,excel,sqlserver & oracle.
en fonction de ton fichier d depart le script change.
TXT vers SQL Server ou excel vers SQL Server,Access vers Acces.
paul.

**a_paul** · 28/09/2009, 09h32

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
'Référence-VBAPoject : Microsolft DAO 3.6 Object Library
Sub CreateBaseBisAccess()
Dim DB As Database, DBX As Database, sDestination As String
Dim RS As DAO.Recordset, TableEnCour As DAO.Recordset
Dim fldLoop As Field, tdfNew As TableDef
 
On Error Resume Next
Set DBX = OpenDatabase("E:\Documents and Settings\PAUL\Bureau\auteurs.xls", False, gnReadOnly, "Excel 5.0;")
Set TableEnCour = DBX.OpenRecordset("auteurs$", dbOpenDynaset, dbSeeChanges, dbOptimistic)
Screen.MousePointer = 11
sDestination = "E:\Documents and Settings\PAUL\Bureau\DEMO\FICHIER\auteurs.XLS"
 
Set DB = OpenDatabase(sDestination, False, gnReadOnly, "Excel 5.0;")
 
Do Until TableEnCour.EOF
Set RS = DB.OpenRecordset("select * FROM [auteurs$] WHERE ((([auteurs$].[id_auteur]) Like '" & TableEnCour.Fields(0).Value & "'))", dbOpenDynaset, dbSeeChanges, dbOptimistic)
If RS.RecordCount = 0 Then
RS.AddNew
Else
RS.Edit
End If
RS.Fields("id_auteur").Value = TableEnCour.Fields("id_auteur").Value
RS.Fields("nom_auteur").Value = TableEnCour.Fields("nom_auteur").Value
RS.Fields("pn_auteur").Value = TableEnCour.Fields("pn_auteur").Value
RS.Fields("téléphone").Value = TableEnCour.Fields("téléphone").Value
RS.Fields("adresse").Value = TableEnCour.Fields("adresse").Value
RS.Fields("ville").Value = TableEnCour.Fields("ville").Value
RS.Fields("pays").Value = TableEnCour.Fields("pays").Value
RS.Fields("code_postal").Value = TableEnCour.Fields("code_postal").Value
RS.Fields("contrat").Value = TableEnCour.Fields("contrat").Value
RS.Update
TableEnCour.MoveNext
Loop
TableEnCour.Close
DB.Close
Set DB = Nothing
Set TableEnCour = Nothing
Screen.MousePointer = 0
End Sub

**a_paul** · 02/10/2009, 17h27

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
'Référence-VBAPoject : Microsolft DAO 3.6 Object Library
'Excel vers Access
'Module VBA à insérer > Set DBX = OpenDatabase(...)
Sub CreateBaseBisAccess()
Dim DB As Database, DBX As Database, sDestination As String, gExpDB, sTable, idxFrom, idxTo, idxFromName, sType, gsSQLDB
Dim RS As DAO.Recordset, TableEnCour As DAO.Recordset
Dim fldLoop As Field, tdfNew As TableDef
 
On Error Resume Next
Set DBX = OpenDatabase("E:\Documents and Settings\PAUL\Bureau\CLIENTS.XLS", False, gnReadOnly, "Excel 5.0;")
Set TableEnCour = DBX.OpenRecordset("CLIENTS$", dbOpenDynaset, dbSeeChanges, dbOptimistic)
Screen.MousePointer = 11
'pointe sur la base MDB
sDestination = "E:\Documents and Settings\PAUL\Bureau\DEMO\FICHIER\CLIENTS.MDB"
 
sConnect = ";pwd="
Set DB = OpenDatabase(sDestination, False, gnReadOnly, sConnect)
 
Do Until TableEnCour.EOF
Set RS = DB.OpenRecordset("select * FROM [CLIENTS] WHERE ((([CLIENTS].[codeclient]) Like '" & TableEnCour.Fields(0).Value & "'))", dbOpenDynaset, dbSeeChanges, dbOptimistic)
If RS.RecordCount = 0 Then
RS.AddNew
Else
RS.Edit
End If
RS.Fields("codeclient").Value = TableEnCour.Fields("codeclient").Value
RS.Fields("société").Value = TableEnCour.Fields("société").Value
RS.Fields("contact").Value = TableEnCour.Fields("contact").Value
RS.Fields("fonction").Value = TableEnCour.Fields("fonction").Value
RS.Fields("adresse").Value = TableEnCour.Fields("adresse").Value
RS.Fields("ville").Value = TableEnCour.Fields("ville").Value
RS.Fields("région").Value = TableEnCour.Fields("région").Value
RS.Fields("code postal").Value = TableEnCour.Fields("code postal").Value
RS.Fields("pays").Value = TableEnCour.Fields("pays").Value
RS.Fields("téléphone").Value = TableEnCour.Fields("téléphone").Value
RS.Fields("fax").Value = TableEnCour.Fields("fax").Value
RS.Update
TableEnCour.MoveNext
Loop
TableEnCour.Close
DB.Close
Set DB = Nothing
Set TableEnCour = Nothing
Screen.MousePointer = 0
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
'Référence-VBAPoject : Microsolft DAO 3.6 Object Library
'Access vers Excel
'Module VBA à insérer > Set DBX = OpenDatabase(...)
Sub CreateBaseBisAccess()
Dim DB As Database, DBX As Database, sDestination As String, gExpDB, sTable, idxFrom, idxTo, idxFromName, sType, gsSQLDB
Dim RS As DAO.Recordset, TableEnCour As DAO.Recordset
Dim fldLoop As Field, tdfNew As TableDef
 
On Error Resume Next
Set DBX = OpenDatabase("E:\Documents and Settings\PAUL\Bureau\CLIENTS.MDB", False, gnReadOnly, "")
Set TableEnCour = DBX.OpenRecordset("CLIENTS", dbOpenDynaset, dbSeeChanges, dbOptimistic)
Screen.MousePointer = 11
'pointe sur la base XLS
sDestination = "E:\Documents and Settings\PAUL\Bureau\DEMO\FICHIER\CLIENTS.XLS"
 
Set DB = OpenDatabase(sDestination, False, gnReadOnly, "Excel 5.0;")
 
Do Until TableEnCour.EOF
Set RS = DB.OpenRecordset("select * FROM [CLIENTS] WHERE ((([CLIENTS$].[codeclient]) Like '" & TableEnCour.Fields(0).Value & "'))", dbOpenDynaset, dbSeeChanges, dbOptimistic)
If RS.RecordCount = 0 Then
RS.AddNew
Else
RS.Edit
End If
RS.Fields("codeclient").Value = TableEnCour.Fields("codeclient").Value
RS.Fields("société").Value = TableEnCour.Fields("société").Value
RS.Fields("contact").Value = TableEnCour.Fields("contact").Value
RS.Fields("fonction").Value = TableEnCour.Fields("fonction").Value
RS.Fields("adresse").Value = TableEnCour.Fields("adresse").Value
RS.Fields("ville").Value = TableEnCour.Fields("ville").Value
RS.Fields("région").Value = TableEnCour.Fields("région").Value
RS.Fields("code postal").Value = TableEnCour.Fields("code postal").Value
RS.Fields("pays").Value = TableEnCour.Fields("pays").Value
RS.Fields("téléphone").Value = TableEnCour.Fields("téléphone").Value
RS.Fields("fax").Value = TableEnCour.Fields("fax").Value
RS.Update
TableEnCour.MoveNext
Loop
TableEnCour.Close
DB.Close
Set DB = Nothing
Set TableEnCour = Nothing
Screen.MousePointer = 0
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
'Référence-VBAPoject : Microsolft DAO 3.6 Object Library
'Access ver SQL Server
'Module VBA à insérer > Set DBX = OpenDatabase(...)
Sub CreateBaseBisAccess()
Dim DB As Database, DBX As Database, sDestination As String, gExpDB, sTable, idxFrom, idxTo, idxFromName, sType, gsSQLDB
Dim RS As DAO.Recordset, TableEnCour As DAO.Recordset
Dim fldLoop As Field, tdfNew As TableDef
 
On Error Resume Next
Set DBX = OpenDatabase("E:\Documents and Settings\PAUL\Bureau\CLIENTS.MDB", False, gnReadOnly, "")
Set TableEnCour = DBX.OpenRecordset("CLIENTS", dbOpenDynaset, dbSeeChanges, dbOptimistic)
Screen.MousePointer = 11
sDestination = "UID=SA;PWD=;DRIVER={SQL Server};SERVER=CELINE;DATABASE=pubs;"
 
Set DB = OpenDatabase("", False, gnReadOnly, "UID=SA;PWD=;DRIVER={SQL Server};SERVER=CELINE;DATABASE=pubs;")
 
Do Until TableEnCour.EOF
If Not DB Is Nothing Then Set DB = Nothing
Set DB = OpenDatabase("", False, gnReadOnly, "UID=SA;PWD=;DRIVER={SQL Server};SERVER=CELINE;DATABASE=pubs;")
Set RS = DB.OpenRecordset("select * FROM [CLIENTS] WHERE ((([CLIENTS].[codeclient]) Like '" & TableEnCour.Fields(0).Value & "'))", dbOpenDynaset, dbSeeChanges, dbOptimistic)
If RS.RecordCount = 0 Then
RS.AddNew
Else
RS.Edit
End If
RS.Fields("codeclient").Value = TableEnCour.Fields("codeclient").Value
RS.Fields("société").Value = TableEnCour.Fields("société").Value
RS.Fields("contact").Value = TableEnCour.Fields("contact").Value
RS.Fields("fonction").Value = TableEnCour.Fields("fonction").Value
RS.Fields("adresse").Value = TableEnCour.Fields("adresse").Value
RS.Fields("ville").Value = TableEnCour.Fields("ville").Value
RS.Fields("région").Value = TableEnCour.Fields("région").Value
RS.Fields("code postal").Value = TableEnCour.Fields("code postal").Value
RS.Fields("pays").Value = TableEnCour.Fields("pays").Value
RS.Fields("téléphone").Value = TableEnCour.Fields("téléphone").Value
RS.Fields("fax").Value = TableEnCour.Fields("fax").Value
RS.Update
TableEnCour.MoveNext
Loop
TableEnCour.Close
DB.Close
Set DB = Nothing
Set TableEnCour = Nothing
Screen.MousePointer = 0
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
'Référence-VBAPoject : Microsolft DAO 3.6 Object Library
'SQL Server Ves Access
'Module VBA à insérer > Set DBX = OpenDatabase(...)
Sub CreateBaseBisAccess()
Dim DB As Database, DBX As Database, sDestination As String, gExpDB, sTable, idxFrom, idxTo, idxFromName, sType, gsSQLDB
Dim RS As DAO.Recordset, TableEnCour As DAO.Recordset
Dim fldLoop As Field, tdfNew As TableDef
 
On Error Resume Next
Set DBX = OpenDatabase("", False, gnReadOnly, "UID=SA;PWD=;DRIVER={SQL Server};SERVER=CELINE;DATABASE=pubs;")
Set TableEnCour = DBX.OpenRecordset("clients", dbOpenDynaset, dbSeeChanges, dbOptimistic)
Screen.MousePointer = 11
'pointe sur la base MDB
sDestination = "E:\Documents and Settings\PAUL\Bureau\CLIENTS.MDB"
 
sConnect = ";pwd="
Set DB = OpenDatabase(sDestination, False, gnReadOnly, sConnect)
 
Do Until TableEnCour.EOF
Set RS = DB.OpenRecordset("select * FROM [clients] WHERE ((([clients].[codeclient]) Like '" & TableEnCour.Fields(0).Value & "'))", dbOpenDynaset, dbSeeChanges, dbOptimistic)
If RS.RecordCount = 0 Then
RS.AddNew
Else
RS.Edit
End If
RS.Fields("codeclient").Value = TableEnCour.Fields("codeclient").Value
RS.Fields("société").Value = TableEnCour.Fields("société").Value
RS.Fields("contact").Value = TableEnCour.Fields("contact").Value
RS.Fields("fonction").Value = TableEnCour.Fields("fonction").Value
RS.Fields("adresse").Value = TableEnCour.Fields("adresse").Value
RS.Fields("ville").Value = TableEnCour.Fields("ville").Value
RS.Fields("région").Value = TableEnCour.Fields("région").Value
RS.Fields("code postal").Value = TableEnCour.Fields("code postal").Value
RS.Fields("pays").Value = TableEnCour.Fields("pays").Value
RS.Fields("téléphone").Value = TableEnCour.Fields("téléphone").Value
RS.Fields("fax").Value = TableEnCour.Fields("fax").Value
RS.Update
TableEnCour.MoveNext
Loop
TableEnCour.Close
DB.Close
Set DB = Nothing
Set TableEnCour = Nothing
Screen.MousePointer = 0
End Sub

Mise à jour, insertion données depuis un fichier excel

VBA Access

Discussions similaires

Partager

Partager