CONNEXION BASES DE DONNÉES

Option Compare Database

Public bdd

Public cn As New ADODB.Connection
Public cnString As String
Public table, chp1, chp2
Public dbs
Public rst

'***********************************************************************************************************
'***********************************LES SOUS FONCTIONS: ELLES CONTIENNENT LE PRINCIPAL DU CODE**************
'C EST NAMEBDD ET OPENCN QU IL VA FALLOIR CHANGER SI LE CODE EST RESPONSABLE DE LA NON CONNECTION AU BDD SQL SERVEUR
'***********************************************************************************************************
Public Sub nameBDD()
bdd = choisirAutreBase.filename
table = nomTable
chp1 = champ1
chp2 = champ2
'chp1 = "NomEF"
'chp2 = "NomEM"
'table = "configuration_active"
End Sub
Public Sub openCN()
Call nameBDD
'Dim cnString As ADODB.Connection
'Set cnString = New ADODB.Connection
If InStr(Len(bdd) - 5, bdd, ".mdb") <> 0 Then
cnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & bdd
Else
'TOUS CES TEST NE SONT PAS OK
''cnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.FullName & ";"
''cn.ConnectionString = "Provider=SQLOLEDB;;Data Source=DSNsqlServeur;INITIAL CATALOG=" & bdd & ";integrated seurity=sspi;"
''cnString.ConnectionString = "Provider=SQLOLEDB;;Data Source=DSNsqlServeur;INITIAL CATALOG=C:\Program Files\Microsoft SQL Server\MSSQL.2\MSSQL\Data\2008 serveur umts 1.mdf ;Connect Timeout=30;User Instance=True;" 'integrated seurity=sspi;"
''cnString = "Provider=SQLOLEDB;DATA SOURCE=SQL serveur (SQLEXPRESS);INITIAL CATALOG=" & bdd & ";INTEGRATED SECURITY=SSPI;"
''cnString = "Provider=SQLOLEDB;DATA SOURCE=%lenomdemonordi%\c$\programfiles\Microsoft SQL Server_MSQL.1\Binn\sqlservr.exe -s SQLEXPRESS;INITIAL CATALOG=" & bdd & ";INTEGRATED SECURITY=BSTR;"
''cnString = "Provider=SQLOLEDB;DATA SOURCE=" & CurrentProject.FullName & ";INITIAL CATALOG=" & bdd & ";INTEGRATED SECURITY=BSTR;"
'cnString = "Provider=SQLOLEDB;DATA SOURCE=.\SQLExpress;INITIAL CATALOG=" & bdd & ";INTEGRATED SECURITY=BSTR;USER INSTANCE = true"

'CE TEST EST REUSSI IL FAUT ALLER CHERCHER LA TABLE ATTACHEE QUI SE TROUVE DANS PROGRAM FILE MICROSOFT MMSQL MMSQL1 DATA
cnString = "Driver={SQL Native Client};Server=.\SQLExpress;AttachDbFilename=" & bdd & "; Database=" & "" & ";Trusted_Connection=Yes;"
End If

'cn.Open
cn.Open cnString



End Sub
'***********************************************************************************************************
'*********************************SI DESSUS LES FONCTION A MANIPULER CI DESSOUS LES FONCTIONS ET************
'*********************************PROCEDURE PERMETTEANT LA CONNECTION LECTURE ET ECRITURE DANS UNE BDD******
Public Sub openrstADO()
Set rst = New ADODB.Recordset
End Sub
Public Sub openrstDAO()
'Set rst = New DAO.Recordset
End Sub

Public Sub configureDbs()
Call nameBDD
Set dbs = DBEngine.Workspaces(0).OpenDatabase(bdd)
End Sub
Public Sub ecriture()
rst.AddNew
rst(chp1) = champ1Value
rst(chp2) = champ2Value
rst.Update
End Sub
Public Sub ecritureADO()
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseClient
rst.CursorType = adOpenDynamic
rst.LockType = adLockOptimistic
rst.Open table, cn ', adOpenKeyset, adLockOptimistic
rst.Fields(chp1) = champ1Value
rst.Fields(chp2) = champ2Value
rst.Update
End Sub

Public Sub lecture()
rst.MoveFirst
While Not rst.EOF
recupData = recupData & "just for testing: " & rst(chp1) & vbCrLf
recupData = recupData & "just for testing: " & rst(chp2) & vbCrLf
rst.MoveNext
Wend
End Sub
Public Sub closeDAO()
dbs.Close
Set dbs = Nothing
Set rst = Nothing
End Sub
Public Sub closeADO()
cn.Close
Set rst = Nothing
Set cn = Nothing
End Sub
'***********************************************************************************************************
'***********************************************************************************************************
'***********************************************************************************************************

Private Sub clean_Click()
recupData = ""
End Sub
Public Sub ecritADO()
Call openCN
Call ecritureADO
Set Forms("Formulaire2").Recordset = rst
Call closeADO
End Sub
Public Sub litADO()
Call openCN
Call openrstADO
rst.Open "SELECT * FROM " & table & " ", cn ', adOpenKeyset, adLockOptimistic
Call lecture
Call closeADO
End Sub
Public Sub ecritDAO()
Call configureDbs
Call openrstDAO
Set rst = dbs.OpenRecordset(table)
Call ecriture
Call closeDAO
End Sub
Public Sub litDAO()
Call configureDbs
Call openrstDAO
Set rst = dbs.OpenRecordset("SELECT * FROM " & table, dbOpenDynaset, dbSeeChanges)
Call lecture
Call closeDAO
End Sub

'***********************************************************************************************************
'**************************procedures de gestion des evenements de clic sur les bouttons********************
'***************************on appelle les sous procedures**************************************************
Private Sub Commande10_Click() 'ado ecrit
Call ecritADO
End Sub
Private Sub Commande9_Click() 'ado lit
Call litADO
End Sub
Private Sub Commande4_Click() 'dao ecrit
Call ecritDAO
End Sub
Private Sub Commande5_Click() 'dao lit
Call litDAO
End Sub

Private Sub choixFichier_Click()
On Error GoTo ErrorHandlerChoixFichier
Dim oDialog As Object
Dim NomFichier As String
Set oDialog = choisirAutreBase.Object
With oDialog
.DialogTitle = "fichier à analyser"
.Filter = "Fichiers (*.mdb)|*.mdb|Fichiers (*.adp)|*.adp|Fichiers (*.mdf)|*.mdf|tous le fichiers (.*)|*.*"
.FilterIndex = 1
.ShowOpen
If Len(.filename) > 0 Then
nomBaseDonnee.Caption = .filename
End If
End With
ErrorHandlerChoixFichier:
Err.Clear
End Sub

'***********************************************************************************************************
'**************************chargement du formulaire*********************************************************
'***********************************************************************************************************

Private Sub Form_Load()
nomBaseDonnee.Caption = "choisir une bdd"
nomBaseDonnee.Visible = True
champ1 = "nom du champ1"
champ2 = "nom du champ2"
nomTable = "nom de la table"
champ1Value = "valeur a inserer"
champ2Value = "valeur a inserer"
End Sub