Requete select sur une table foxpro

Option Explicit

Dim connect_foxpro As New ADODB.Connection 'Connexion sur base Fox Pro
Dim cmd_fox As New ADODB.Command 'Commande
Dim rqt_fox As New ADODB.Recordset 'Recordset
Dim connecter_base As Boolean 'Variable permettant de savoir si la personne s'est connecté à la base Fox Pro


'FONCTION PERMETTANT DE SE CONNECTER SUR UNE BASE FOX PRO
Function Connexion(chemin_rep As String)
Dim CHEMIN As String
CHEMIN = chemin_rep

'Si renvoie Vrai , connexion réussie
'Sinon renvoie le numéro de l'erreur de connexion
On Error GoTo error_connexion:

'chemin est une constante indiquant tout simplement le répertoire de la table
connect_foxpro.ConnectionString = "DRIVER={Microsoft Visual FoxPro Driver};SourceType=DBF;SourceDB=" & CHEMIN
connect_foxpro.Open
connecter_base = True
Connexion = True

Exit Function

error_connexion:
Connexion = Err.Number

End Function

'FONCTION PERMETTANT DE SE DECONNECTER D'UNE BASE FOX PRO
Function Deconnexion()

'Si renvoie 1 , deconnexion réussie
'Sinon renvoie le numéro de l'erreur de deconnexion
On Error GoTo error_deconnexion:

connect_foxpro.Close
Set connect_foxpro = Nothing
connecter_base = False
Deconnexion = True
Exit Function

error_deconnexion:
Deconnexion = Err.Number

End Function

CLEAR
LOCAL oConn as "adodb.connection"
LOCAL oRS as "adodb.recordset"
oConn = CREATEOBJECT('adodb.connection')
oRS = CREATEOBJECT('adodb.recordset')
cConnStrng = ;
   "Provider=vfpoledb;Data Source="+HOME(2)+"northwind\northwind.dbc"
oConn.CursorLocation= 3            && adUseClient
oConn.Open(cConnStrng)

*!* Open RecordSet using keyset cursor and optimistic locking.
oRS.Open(;
   "SELECT * FROM customers WHERE customerid = 'CACTU'",oConn,1,3,1)
? 'Current value:',oRS.Fields("contactname").Value
oRS.Fields("contactname").Value = "Patricio X. Simpson"
oRS.Update()
oRS.Requery()
? 'New value:',oRS.Fields("contactname").Value
oRS.Close()
oConn.Close()

Option Explicit

Dim targetRange As Range
Dim intColIndex As Integer
Dim nbRecords As Integer
Dim che_fic As String

Dim cnx As ADODB.Connection
Dim cmd As ADODB.Command
Dim rs As ADODB.Recordset

Sub Afficher(nomTab As String)

    nbRecords = 0
    
    'Connexion à la base
    Set cnx = New Connection
    'chemin est une constante indiquant tout simplement le répertoire de la table
    With cnx
        .ConnectionString = "Provider = vfpoledb; Data Source =" + CHEMIN + nomTab
        .Open
    End With
    
    'Préparation de l'objet command
    Set cmd = New ADODB.Command
    Set cmd.ActiveConnection = cnx
    
    cmd.CommandText = REQ_SELECT
    
    'On déclare le recordset
    Set rs = New ADODB.Recordset
    
    'Exécute la requête
    rs.Open cmd, CursorType:=adOpenStatic
    
    'On sélectionne la feuille de destination
    ActiveWorkbook.Sheets(NOM_FEUILLE_SELECT).Activate
    
    'On efface l'ensemble du contenu précédent
    ActiveSheet.Cells.Clear
    
    'On vérifie que l'on a bien récupéré des enregistrements
    If Not rs.EOF Then
    
        rs.MoveFirst
        Set targetRange = ActiveWorkbook.Sheets(NOM_FEUILLE_SELECT).Cells(1, 1)
        
        ' Mise en place des noms de champs comme entêtes de colonne
        For intColIndex = 0 To rs.Fields.Count - 1
            targetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
        Next
    
        Application.StatusBar = "Extraction des enregistrements ..."
        ' Vide le contenu du jeu d'enregistrements dans la feuille de calcul Excel
        targetRange.Offset(1, 0).CopyFromRecordset rs
        Sheets(NOM_FEUILLE_SELECT).Columns("A:Z").AutoFit
       
        nbRecords = rs.RecordCount
        MsgBox "Import de " & nbRecords & " enregistrement(s) !"
        
     Else
        MsgBox "Il n'y a aucun enregistrement correspondant.", vbInformation, "Enregistrement impossible"
        
    End If
    
    Application.StatusBar = ""
    ' Ferme le jeu d'enregistrements s'il est toujours ouvert
    If CBool(rs.State And adStateOpen) Then rs.Close
    
    'Enregistrement des modifications des feuilles excel
    Application.DisplayAlerts = False
    che_fic = REP_FIC + NOM_FIC
    ActiveWorkbook.SaveAs che_fic
    Application.DisplayAlerts = True
        
    ActiveWorkbook.Sheets(NOM_FEUILLE_PRINCIPAL).Activate
    
    cnx.Close
    
    Set cnx = Nothing
    Set rs = Nothing
    Set targetRange = Nothing
    Set cmd = Nothing

End Sub

Sub Insert(nomTab As String)
    
    Dim cnx As ADODB.Connection
    Dim cmd As ADODB.Command
    
    'Connexion à la base
    Set cnx = New Connection
    'chemin est une constante indiquant tout simplement le répertoire de la table
    With cnx
        .ConnectionString = "Provider = vfpoledb; Data Source =" + CHEMIN + nomTab
        .Open
    End With
    
    'Préparation de l'objet command
    'Set cmd = New ADODB.Command
    'Set cmd.ActiveConnection = cnx
    
    'On exécute l'insert
    cnx.Execute REQ_INSERT, adCmdText
    
    cnx.Close
    
    Set cnx = Nothing
    Set cmd = Nothing
End Sub

Public Const REQ_INSERT As String = "Insert Into client Values (000001,'','FLORIAN GARNIER','FR454545454','DEVELOPPEUR EN INFORMATIQUE','65 KINGSTON ROAD','KINGSTON BOULEVARD STATION','44120','VERTOU','FRA','0044 0645 445 455',00443222323232,'FRA',201200,'',11111111,'','AS24 FR','EUR','VIRT DEVISE CLIENT','BPBA','P/O BOX 44','POOLE','','Test - TEST ajout','28/08/2010','12/12/2010',0,'TEST ADR','TEST ADR2',0,0,'00/01/1900',0,'00/01/1900','00/01/1900','00/01/1900',0,'FRBARGO44',0,1,0,0,0,1,'TACTAC','',0,0,0,'00/01/1900','','cif','66 ROAD STREET','ROAD STREET','GG44 5BT','NANTES','00/01/1900',0,'F5','ffffff','ffffff','FG','00/01/1900','','FR45454545454545454ACM',0,'00/01/1900','00/01/1900','FRA',0,'',1,0007,'FRA',0,0,0007,'00/01/1900')"