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 |
Partager