Soyez le premier à donner votre avis sur cette source.
Snippet vu 17 804 fois - Téléchargée 9 fois
' 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
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.