Connexion à un fichier excel comme base de données

Soyez le premier à donner votre avis sur cette source.

Snippet vu 16 950 fois - Téléchargée 8 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 DB As New ADODB.Connection
Public RS As New Recordset
    
'    CONNEXION
Public Function DBConnect(ByVal sXlsPath As String, ByVal bUseFirstRowAsHeader As  Boolean) As  Boolean
    Me.DBClose
    With DB
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & sXlsPath & ";Extended Properties=""Excel 8.0;HDR=" & IIf(bUseFirstRowAsHeader, "Yes", "No") & ";IMEX=1;"""
        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


'exemple  d'utilisation : Feuill1 contient une première ligne avec le nom des  champs
    Dim xls As New Class1
    xls.DBConnect "c:\test.xls", True
     
    'select sur 1ère colonne
    xls.RSExecute "SELECT [NOM] FROM  [Feuill1$];"
    
    'affiche le 1e  enregistrement
    MsgBox xls.RS.Fields(0).Value
    Set xls = Nothing

'exemple d'utilisation : Feuill2 contient directement les valeurs  (pas de nom de champ)
    Dim xls As New Class1
    xls.DBConnect "c:\test.xls", False
    
    'select sur 1ère colonne
    xls.RSExecute "SELECT [F1] FROM  [Feuill2$];"
    
    'affiche le 1e  enregistrement
    MsgBox xls.RS.Fields(0).Value
    Set xls = Nothing


Compatibilité : VB6, VBA

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.