ACCÈS À TOUS TYPES DE BASE DE DONNÉES VIA ADODB

Public sub Connection()

Dim CoLilas As New ADODB.Connection
Dim Rec_Mod As New ADODB.Recordset
Dim Rec_Estamp As New ADODB.Recordset

Dim Ident as string
Dim Provider as string
Dim Connexion as string
Dim Connectdb as Boolean


'**** C'est à vous de choisir le type de base auquel vous voulez accèder.

'*** Connexion Sql Serveur.
Provider = "SQLOLEDB.1"   
Connexion = "Persist Security Info=False;" & _
            "User ID=admin; Password=admin;Initial Catalog=BASE-TEST;" & _
            "Data Source=SERVEURSQL"
    
'*** connexion Fichier Base Access 95,97
'Provider = "Microsoft.JET.OLEDB.3.51"  
'Connexion = "C:\Base\ma_db.mdb"

'*** connexion Fichier Base Access 2000,XP
'Provider = "Microsoft.JET.OLEDB.4.0"  
'Connexion = "C:\Base\ma_db.mdb"

'*** connexion via un base déclaré dans ODBC
'Provider = "MSDASQL.1" 
'Connexion = "Data Source=BASE-TEST"

'*** connexion à une base Oracle
'Provider = "MSDAORA" 
'Connexion = "Data Source=BASE-TEST;User ID=admin;" & _
'            "Password=admin"

         
'**** Connexion à la Base de données
ConnectBd = True
With CoLilas
  .Provider = Provider
  .ConnectionString = Connexion
  .ConnectionTimeout = 6
  .CommandTimeout = 60
  .Open
End With
ConnectBd = False


'**** Lecture d'un enregistrement
ident = "123"
Rec_Estamp.Open "select DADMAJ, HEUMAJ from TAB1 where CDVERS ='1'" & _
                " and CDPRG = '" & Ident & "';", CoLilas, adOpenForwardOnly, adLockReadOnly
                
If Rec_Estamp.EOF Then
   ok = MsgBox("Erreur lors de la lecture de la date de mise à jour !", vbExclamation + vbSystemModal, "LilasExplor")
Else
   msgbox Rec_Estamp!DADMAJ & Rec_Estamp!HEUMAJ
End If
Rec_Estamp.Close



'**** Mise à jour
Ident = "153243"
Rec_Mod.Open "select DADMAJ, HEUMAJ from TAB2 where CDVERS ='1'" & _
             " and CDFOAP = '" & Mid(Ident, 1, 2) & _
             "' and CDARL = '" & Mid(Ident, 3) & "';", CoLilas, adOpenDynamic, adLockPessimistic
                  
If Rec_Mod.EOF Then
   ok = MsgBox("Erreur lors de la mise à jour !" & vbCrLf & "Enregistrement non trouvé !", vbExclamation + vbSystemModal, "LilasExplor")
Else
   Rec_Mod!DADMAJ = Format(Date, "YYYYMMDD")
   Rec_Mod!HEUMAJ = Format(Time, "HHMMSS")
   Rec_Mod.Update
End If
Rec_Mod.Close



Exit Sub
gestion_erreur:
   If ConnectBd = True Then

       '**** Gestion des erreurs de connexion à la base de données.
       Err_debut = True
       ok = MsgBox("Erreur de connexion à la base de données.", vbExclamation + vbSystemModal, "LilasExplor")
   
       'Call Info_Err("Module1", "Sub_Connection")
   Else
     'Call Info_Err("Module1", "Sub_Connection")
   End If
End Sub