Connexion à une base de données Access

Soyez le premier à donner votre avis sur cette source.

Snippet vu 50 931 fois - Téléchargée 7 fois

Contenu du snippet

'   COPIEZ LE CODE  CI-DESSOUS DANS UN MODULE DE CLASS, VOUS AVEZ ACCES AUX OBJETS DB ET  RS
Option Explicit
'   msado25.tlb (Microsoft ActiveX Data Objects 2.5  Library)
'   msadox.dll (Microsoft ADO Ext. 2.7  for DLL and  Security)
Public Enum eDBJetEngineType
    Jet10 = 1
    Jet11 = 2
    Jet20 = 3 '(Access 2)
    Jet3x = 4 '(Access 97)
    Jet4x = 5 '(Access 2000, XP-2002, 2003)
End Enum
'
Public DB As New ADODB.Connection
Public RS As New Recordset
    
'    CONNEXION
Public Function DBConnect(ByVal sDBPath As String, Optional ByVal sPassword As String = vbNullString, Optional ByVal  eDBJetEngine As  eDBJetEngineType = Jet4x) As Boolean
    Me.DBClose
    With DB
        .Provider = "Microsoft.jet.OLEDB.4.0;Data Source=" & sDBPath & ";Jet OLEDB:Database Password=" & sPassword & ";Jet OLEDB:Engine Type=" & CStr(eDBJetEngine) & ";"
        On Error GoTo Err_Handler
        .Open
        DBConnect = True
        Exit Function
    End With
Err_Handler:
    Debug.Print "[DBConnect] " & Err.Number & " : " & Err.Description
End Function
'   FERMETURE  DB
Public Sub DBClose()
    Me.DB.Cancel
    If Me.DBConnected Then Me.DB.Close
End Sub
'   BASE CONNECTéE ?
Public Function DBConnected() As Boolean
    DBConnected = Not (Me.DB.State = adStateClosed)
End Function
'    REQUÊTE
Public Function RSExecute(ByVal sSql As String) As Boolean
    If Me.DBConnected Then
        Call RSClose
        Me.RS.CursorLocation = adUseClient
        On Local Error GoTo Err_Handler
        Me.RS.Open sSql, Me.DB, adOpenDynamic, adLockOptimistic,  -1
        RSExecute = True
    End If
    Exit Function
Err_Handler:
    Debug.Print "[RSExecute] " & Err.Number & " : " & Err.Description
End Function
'   FERMETURE  RS
Private Sub RSClose()
    Me.RS.Cancel
    If Not (Me.RS.State = adStateClosed) Then  Me.RS.Close
End Sub
'   DESTRUCTION  CLASS
Private Sub Class_Terminate()
    Call RSClose:   Set Me.RS = Nothing
    Me.DBClose:     Set Me.DB = Nothing
End Sub


Compatibilité : VB6, VBA

Disponible dans d'autres langages :

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.