≡ Logitheque.com
Logitheque.com
Publicité
 ≡ Accueil > Forums  > Informatique  > Programmation
Publicité

MODULES INSERTION ET MISE À JOUR DES DONNÉES DANS UNE TABLE( SGBD )

Répondre à ce messageRetourPas connectéVous connecterVous inscrire
≡ 
0 - MODULES INSERTION ET MISE À JOUR DES DONNÉES DANS UNE TABLE( SGBD )
Donner un bon point à ce message Noter négativement ce message
0
Par apaul1954
Utilisateur
 Le 02/10/2009 17:21:38 Signaler un contenu illicite Répondre à apaul1954


 

Site : PaScript Editeur de bases

'Référence-VBAPoject : Microsolft DAO 3.6 Object Library
'Excel 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("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


'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


'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


'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

 

 

 
 bouffémont http://multibases.site.voila.fr/index.html

 ≡ Logitheque.com
CHERCHER