Module de classe : export requete fox pro vers acess et texte
Soyez le premier à donner votre avis sur cette source.
Vue 4 733 fois - Téléchargée 242 fois
Description
Module de classe qui permet de se connecter sur n'importe quelle base de type Visual Fox Pro, de lui passer une requête SQL et d'exporter le résultat de cette requête au format texte ou Access.
C'est ma premiére source que je poste, je sais pas si ça apportera quelque chose à quelqu'un ... tous vos commentaires sont les bienvenues, sur la structure du code, comment l'optimiser, etc ...
Je pense rajouter l'export au format Excel et en html ....
Et permettre de se connecter sur autre chose que du fox pro à la base serait pas mal non plus, mais bon, j'avais besoin d'exporter du fox pro à la base ...
Je sais pas trop dans quel niveau mettre ma source ... je me considere encore comme débutant donc je la met là :-)
C'est ma premiére source que je poste, je sais pas si ça apportera quelque chose à quelqu'un ... tous vos commentaires sont les bienvenues, sur la structure du code, comment l'optimiser, etc ...
Source / Exemple :
Dim 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 Integer 'Variable permettant de savoir si la personne s'est connecté à la base Fox Pro
Dim newbase As ADOX.Catalog 'Pour création d'une base access
Dim tbl As Table 'Pour création d'une table dans Access
Dim access_externe As ADODB.Connection 'Connection sur la base créé
'FONCTION PERMETTANT DE SE CONNECTER SUR UNE BASE FOX PRO
Function Se_connecter_foxpro(ByVal chem_base As String)
'Si renvoie 1 , connexion réussie
'Sinon renvoie le numéro de l'erreur de connexion
On Error GoTo error_connexion:
foxpro.ConnectionString = "DRIVER={Microsoft Visual FoxPro Driver};SourceType=DBF;SourceDB=" & chem_base
foxpro.Open
connecter_base = 1
Se_connecter_foxpro = 1
Exit Function
error_connexion:
Se_connecter_foxpro = Err.Number
Exit Function
End Function
'FONCTION PERMETTANT DE SE DECONNECTER D'UNE BASE FOX PRO
Function Se_deconnecter_foxpro()
'Si renvoie 1 , deconnexion réussie
'Sinon renvoie le numéro de l'erreur de deconnexion
On Error GoTo error_deconnexion:
foxpro.Close
Set foxpro = Nothing
connecter_base = 0
Se_deconnecter_foxpro = 1
Exit Function
error_deconnexion:
Se_deconnecter_foxpro = Err.Number
Exit Function
End Function
'FONCTION PERMETTANT D'EXPORTER UN RESULTAT DE REQUETE SQL AU FORMAT TEXTE
Function Exporter_requete_texte(ByVal Requete_SQL As String, ByVal chemin_export As String, ByVal nom_fichier_export_avec_extension As String, ByVal separateur_texte As String)
On Error GoTo error_export_txt:
'Variable fonctions
Dim chaine_txt As String 'Chaine a ecrire dans le fichier texte à chaque fois
'Je teste si la personne s'est connecté sur la base auparavant avec réussite
If connecter_base <> 1 Then
MsgBox "Connecter vous auparavant sur la base Fox Pro avant de réaliser un export !", vbInformation, "Erreur init"
Else
'Je commence par exécuter la requête SQL sur ma base Fox Pro suite à ma connexion
cmd_fox.ActiveConnection = foxpro
cmd_fox.CommandText = Requete_SQL
rqt_fox.CursorLocation = adUseClient
rqt_fox.CursorType = adOpenDynamic
rqt_fox.LockType = adLockPessimistic
rqt_fox.Open cmd_fox
'Si pas d'erreur alors je peux enchainer sur l'export de mon recordset au format souhaité
Open chemin_export & nom_fichier_export_avec_extension For Output As #1
'Je recupere le nom de mes colonnes en-tete
For i = 1 To rqt_fox.Fields.count - 1
If i = 1 Then
chaine_txt = Trim(rqt_fox.Fields(i).Name)
Else
chaine_txt = chaine_txt & separateur_texte & Trim(rqt_fox.Fields(i).Name)
End If
Next i
Print #1, chaine_txt
'J'exporte ensuite le reste des valeurs de mon recordset
rqt_fox.MoveFirst
While Not rqt_fox.EOF
For i = 1 To rqt_fox.Fields.count - 1
If i = 1 Then
chaine_txt = Trim(rqt_fox.Fields(i).Value)
Else
chaine_txt = chaine_txt & separateur_texte & Trim(rqt_fox.Fields(i).Value)
End If
Next i
Print #1, chaine_txt
rqt_fox.MoveNext
Wend
Close #1
rqt_fox.Close
Set rqt_fox = Nothing
End If
Exporter_requete_texte = i
Exit Function
error_export_txt:
Exporter_requete_texte = Err.Number
rqt_fox.Close
Set rqt_fox = Nothing
Exit Function
End Function
'FONCTION PERMETTANT D'EXPORTER UN RESULTAT DE REQUETE SQL AU FORMAT ACCESS
Function Exporter_requete_access(ByVal Requete_SQL As String, ByVal chemin_export As String, ByVal nom_fichier_export_avec_extension As String, ByVal nom_table As String)
On Error GoTo error_export_mdb:
'Variable fonction
Dim insert_int As String 'Variable pour préparation requête SQL
Dim quote As Integer 'Index de présence d'une quote
Dim valeur_quote_corriger As String 'Valeur sans la quote
Dim val_inser As String 'Valeur à insérer dans la requête SQL
Dim insertion_def As String 'Requete definitive pour l'insertion des données
Dim access_externe As New ADODB.Connection 'Connection pour insertion des données
Dim reponse_ecrasement As Integer 'Reponse sur ecrasement base
If connecter_base <> 1 Then
MsgBox "Connecter vous auparavant sur la base Fox Pro avant de réaliser un export !", vbInformation, "Erreur init"
Else
'Je commence par exécuter la requête SQL sur ma base Fox Pro suite à ma connexion
cmd_fox.ActiveConnection = foxpro
cmd_fox.CommandText = Requete_SQL
rqt_fox.CursorLocation = adUseClient
rqt_fox.CursorType = adOpenDynamic
rqt_fox.LockType = adLockPessimistic
rqt_fox.Open cmd_fox
'Je crée ma base Access
If Dir(chemin_export & nom_fichier_export_avec_extension, vbHidden) <> "" Then
reponse_ecrasement = MsgBox("Le fichier existe déjà, voulez vous l'écraser ?", vbYesNo, "Confirmation")
If reponse_ecrasement = vbNo Then
Exit Function
Else
'Je supprime mon fichier pour l'écraser
Kill (chemin_export & nom_fichier_export_avec_extension)
End If
End If
Set newbase = New ADOX.Catalog
newbase.Create ("Provider='Microsoft.Jet.OLEDB.4.0';data source=" & chemin_export & nom_fichier_export_avec_extension)
'Je crée ensuite la structure de ma table dans la base créé
Set tbl = New ADOX.Table
tbl.Name = nom_table
For i = 1 To rqt_fox.Fields.count - 1
tbl.Columns.Append Trim(rqt_fox.Fields(i).Name), adVarWChar
Next i
newbase.Tables.Append tbl
Set tbl = Nothing
Set newbase = Nothing
'Je me connecte ensuite sur cette base pour insérer les données
access_externe.ConnectionString = ("Provider='Microsoft.Jet.OLEDB.4.0';data source=" & chemin_export & nom_fichier_export_avec_extension)
access_externe.Open
'Préparation de la requête SQL pour l'insertion des données dans la base créé
'Nom de la table
inser_int = "INSERT INTO " & nom_table & "("
'Liste des champs
For i = 1 To rqt_fox.Fields.count - 1
inser_int = inser_int & rqt_fox.Fields(i).Name & ","
Next i
If inser_int <> "" Then
inser_int = Mid(inser_int, 1, Len(inser_int) - 1)
inser_int = inser_int & ") VALUES ("
End If
'Je balaye ensuite mon recordset pour récupérer l'ensemble des valeurs à exporter
rqt_fox.MoveFirst
While Not rqt_fox.EOF
For i = 1 To rqt_fox.Fields.count - 1
'Je teste s'il va y avoir une quote qui va m'embeter dans l'insertion des données
quote = InStr(1, rqt_fox.Fields(i).Value, "'", vbTextCompare)
If quote <> 0 Then
valeur_quote_corriger = Mid(rqt_fox.Fields(i).Value, 1, quote - 1) & " " & Mid(rqt_fox.Fields(i).Value, quote + 1, (Len(rqt_fox.Fields(i).Value)) - quote)
val_inser = val_inser & "'" & valeur_quote_corriger & "',"
Else
val_inser = val_inser & "'" & Trim(rqt_fox.Fields(i).Value) & "',"
End If
Next i
If val_inser <> "" Then
val_inser = Mid(val_inser, 1, Len(val_inser) - 1)
End If
'Creation de la requete définitive
insertion_def = inser_int & val_inser & ")"
'Execution de la requete sur la base
access_externe.Execute insertion_def
val_inser = ""
rqt_fox.MoveNext
Wend
access_externe.Close
Set access_externe = Nothing
End If
Exit Function
error_export_mdb:
Exporter_requete_mdb = Err.Number
rqt_fox.Close
Set rqt_fox = Nothing
Exit Function
End Function
Private Sub Class_Initialize()
connecter_base = 0
End Sub
Conclusion :
Je pense rajouter l'export au format Excel et en html ....
Et permettre de se connecter sur autre chose que du fox pro à la base serait pas mal non plus, mais bon, j'avais besoin d'exporter du fox pro à la base ...
Je sais pas trop dans quel niveau mettre ma source ... je me considere encore comme débutant donc je la met là :-)
Codes Sources
A voir également
- Module de classe : export requete fox pro vers acess et texte
- Classe metier - Conseils pratiques -Visual Basic / VB.NET
- Module de paiement en ligne ✓ - Forum PHP
- Requete paramétrée - Conseils pratiques -C# / .NET
- Tableau de classe ✓ - Forum VB.NET
- Export csv php ✓ - Forum PHP
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.