Cette fonction permet d'extraire une partie d'une chaîne de caractères quand celle ci a toujours la même structure. Prenons l'exemple suivant : Vous avez un fichier texte qui contient les lignes suivantes :
Marc Dupont, Ville : Paris, E-Mail : mdupont@truc.fr,
Tél.: 43.99.88.09
Yvan Desclous, Ville : Grenoble, E-Mail : desclous@machin.fr, Tél.: 11.22.33.44
Paul Truc, Ville : Berlin, E-Mail : tpaul@chose.fr, Tél.: 44.66.55.88
Pour Extraire l'E-Mail de chacune de ces personnes, je vous souhaite bonne chance, surtout s'il y en a 2'500... La petite fonction que je vous propose d'implémenter va s'occuper de tout cela...
Dans notre exemple, nous voulons mettre l'E-Mail dans une variable VARemail :
LigneComplete = "Marc Dupont, Ville : Paris,
E-Mail : mdupont@truc.fr, Tél.: 43.99.88.09"
VARemail =Extraction(LigneComplete , "E_Mail : " ,
", Tél")
VARemail contiendra exactement la chaîne suivante : mdupont@truc.fr
' UTILITE : Cette fonction permet de récupérer une chaîne de texte dans une chaîne
de caractères, entre
' 2 balises.
' EXEMPLES :
' X = Extraction ("ABCDEFGHIJKL", "CD", "i") Renvoie
"EFGH"
' X = Extraction ("ABCDEFGHIJKL", "#BEGIN#", "i") Renvoie
"ABCDEFGH"
' X = Extraction ("ABCDEFGHIJKL", "#BEGIN#", "#END#")
Renvoie "ABCDEFGHIJKL"
' X = Extraction ("ABCDEFGHIJKL", "J", "#END#") Renvoie
"KL"
' X = Extraction ("ABCDEFGHIJKL", "J", "J") Renvoie
"###INFO 3000 ERREUR : Fin avant de début, ou retour fonction vide ###"
' X = Extraction ("ABCDEFGHIJKL", "J", "K") Renvoie
"###INFO 3000 ERREUR : Fin avant de début, ou retour fonction vide ###"
' X = Extraction ("BxxxA AyyyB", "a", "b") Renvoie
"###INFO 3000 ERREUR : Fin avant de début, ou retour fonction vide ###"
' X = Extraction ("ABCDEFGHIJKL", "XXX", "J") Renvoie
"###INFO 3000 ERREUR : Début inexistant###"
' X = Extraction ("ABCDEFGHIJKL", "XXX", "YYY") Renvoie
"###INFO 3000 ERREUR : Début inexistant###"
' X = Extraction ("ABCDEFGHIJKL", "BC", "XXX") Renvoie
"###INFO 3000 ERREUR : Fin inexistante ###"
' X = Extraction ("AbonjourZ AaurevoirZ", "a", "z") Renvoie
"bonjour"
Function Extraction(ChaineTexte, Depuis, Jusqua)
Dim Ctr As Integer ' Compteur polyvalent
Dim Drapeau As Boolean ' Détermine si une erreur est survenue (les balises
DEPUIS ou JUSQUA n'existent pas)
Dim PositionDebut As Integer ' Contient la position de la fin de la chaine
DEBUT + 1 caractere
Dim PositionFin As Integer ' Contient la position du début de la chaine
JUSQUA
Dim LongueurDepuis As Integer ' Contient la longueur de la balise DEPUIS
Dim LongueurJusqua As Integer ' Contient la longueur de la balise JUSQUA
Dim LongueurChaineTexte As Integer ' Contient la longueur de la chaîne de
caractère complète
LongueurDepuis = Len(Depuis)
LongueurJusqua = Len(Jusqua)
LongueurChaineTexte = Len(ChaineTexte)
' Est-ce que l'utilisateur a entré un mot-clé pour commencer au début :
#BEGIN#
' ou terminer à la fin : #END#
If Depuis = "#BEGIN#" Then
PositionDebut = 1
End If
If Jusqua = "#END#" Then
PositionFin = LongueurChaineTexte
End If
If Depuis <> "#BEGIN#" Then
' Recherche de la délimitation DEBUT du début de la
recherche
Drapeau = False
For Ctr = 1 To LongueurChaineTexte - LongueurDepuis
If Mid$(ChaineTexte, Ctr,
LongueurDepuis) = Depuis Then
Drapeau = True
PositionDebut =
Ctr + LongueurDepuis
Exit For
End If
Next
' Si la délimitation du début DEPUIS n'existe pas,
générer une erreur
If Drapeau = False Then
Extraction = "###INFO 3000 ERREUR :
Début inexistant###"
Exit Function
End If
End If
If Jusqua <> "#END#" Then
' Recherche de la délimitation FIN
Drapeau = False
For Ctr = 1 To LongueurChaineTexte - LongueurJusqua
If Mid$(ChaineTexte, Ctr,
LongueurJusqua) = Jusqua Then
Drapeau = True
PositionFin = Ctr
- 1
Exit For
End If
Next
' Si la délimitation de fin JUSQUA n'existe pas, générer
une erreur
If Drapeau = False Then
Extraction = "###INFO 3000 ERREUR :
Fin inexistante ###"
Exit Function
End If
End If
If PositionFin < PositionDebut Then
Extraction = "###INFO 3000 ERREUR : Fin avant de
début, ou retour fonction vide ###"
Exit Function
End If
' Retour correct de la fonction :
Extraction = (Mid$(ChaineTexte, PositionDebut, PositionFin - (PositionDebut -
1)))
End Function