' 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