[Résolu][Calc] Extraire des courriels parsemés dans un texte

[martinbrait]

Bonjour,

Cas d'utilisation :
Vous est il déjà arrivé de pester en ayant reçu une liste d'adresses mails,
au coeur d'un document texte, que vous auriez souhaité isoler,
pour en faire un traitement spécifique.
Vous auriez pu vouloir adresser un message à chacun des
interlocuteurs dont le mail figure dans le document par exemple ?

Pas de souci,
vous pouvez désormais extraire les mails parsemés dans un texte
via un classeur calc, et utiliser une fonction d'extraction dédiée.

Code : Tout sélectionner

sub TesterExtractionDeMail

'Msgbox Fn2_CaractereExiste("qsfd<martin","<")
MsgBox Fn1_ExtraitMail("bonjour<martin.brait@gmail.com>sqdfzaer")
end sub

'Auteur : martinbrait
'Savoir si un caractère existe
'Sortie booléen.

Code : Tout sélectionner

Function Fn2_CaractereExiste(ChaineTest As String,CaractereTest As String)
Dim i As Integer
Fn2_CaractereExiste=False 'initialisation
For i = 1 To Len(CaractereTest)
	If Instr(i,ChaineTest,CaractereTest)>0 Then
		Fn2_CaractereExiste = True
		Exit For
	End If		
Next
End Function

'Auteur : martinbrait
'Extraire un mail depuis une extraction de texte, copiée en première colonne d'un tableau
'Le mail à retrouver est balisé entre les signes "<" et ">"
'permet d'extraire un mail selon le contenu au format texte, transmis en paramètre.

Code : Tout sélectionner

    Function Fn1_ExtraitMail(ChaineDeCaracteres As String) As Variant
    'fonctionne dans l'environnement Office, quelle que soit l'application soffice ouverte.
    Dim debutmail As Integer, finmail As Integer, longueurmail As Integer
    
    Dim FnIntegree As Object
       FnIntegree= CreateUnoService("com.sun.star.sheet.FunctionAccess")
       
       'on masque la balise de début de mail
       If Fn2_CaractereExiste(ChaineDeCaracteres,"<")=True Then
       debutmail = FnIntegree.CallFunction("SEARCH",array("<",ChaineDeCaracteres,1))
       finmail = FnIntegree.CallFunction("SEARCH",array(">",ChaineDeCaracteres,1))
       longueurmail = finmail - debutmail
	   temp = Replace(FnIntegree.CallFunction("MID",array(ChaineDeCaracteres,debutmail,longueurmail)),"<","")
       Else
       'retourner chaîne vide, si ChaineDeCaracteres n'a pas la balise attestant la présence d'un mail.
       temp=""
       End If
       
       Fn1_ExtraitMail = temp
      
    End Function   
 

Merci et à bientôt !

[Jeff]

Bonjour,

une liste d'adresses mails

Le terme exact est courriel

vous pouvez désormais extraire les mails parsemés dans un texte

La fonction que tu propose n’extrait pas une adresse courriel, mais extrait une chaine de texte entre 2 caractères pré-déterminés.
Cela corresponds en gros à la formule

Code : Tout sélectionner

=STXT(A2;CHERCHE("<";A2)+1;CHERCHE(">";A2)-CHERCHE("<";A2)-1)

Cela pourrait être optimisé en testant si la chaine extraite contient bien le caractère @.
Par exemple, toujours par formule :

Code : Tout sélectionner

=SI(ESTERREUR(CHERCHE("@";A2));"";STXT(A2;CHERCHE("<";A2)+1;CHERCHE(">";A2)-CHERCHE("<";A2)-1))

martinbrait.png

Là où l’approche macro est intéressante, c’est qu’une adresse de courriel peut être composée de lettres, chiffres, caractères spéciaux tel que point, tiret et underscore, ce qui complexifie la "solution formule".

Pour réaliser la macro, le raisonnement pourrait être le suivant :

• On recherche le caractère @
• Si on le trouve, alors par rapport à sa position :
  • on recherche jusqu’en début de texte un caractère autre que ceux énumérés en vert ci-dessus
    cela donnerait le début de l’adresse
  • on recherche jusqu’en fin de texte un caractère autre que ceux énumérés en vert ci-dessus
    cela donnerait la fin de l’adresse
• Si on ne trouve pas le caractère @, alors rien.

[martinbrait]

Bonjour,

Puisque ma fonction semble susciter un intérêt.
J'ajoute une version V2 plus travaillée, en suivant les recommandations de JEFF

Code : Tout sélectionner

' #FUNCTION# ====================================================================================================================
' Name...........: Fn2_CaractereExiste()
' Description ...: 'Savoir si un caractère existe
' Syntax.........: Fn2_CaractereExiste(ChaineTest As String,CaractereTest As String) As Boolean
' Parameters ....: $avArray - Array to modify
'                  $vValue  - Value to add
' Return values .: valeur booléenne
'                  Failure - -1, sets @error
'                  |1 - $avArray is not an array
'                  |2 - $avArray is not a 1 dimensional array
' Author ........: martinbrait
' Modified.......:
' Remarks .......:
'l'argument optionnel de type string correspond au paramètre "nom", ou "prenom"
'l'argument optionnel de type booléen 1 ou 0, correspond au paramètre casse optimisée.
' Related .......: 
' Link ..........;
' Example .......' Yes
' ===============================================================================================================================
Function Fn2_CaractereExiste(ChaineTest As String,CaractereTest As String) As Boolean
Dim i As Integer
Fn2_CaractereExiste=False 'initialisation
For i = 1 To Len(CaractereTest)
	If Instr(i,ChaineTest,CaractereTest)>0 Then
		Fn2_CaractereExiste = True
		Exit For
	End If		
Next
End Function


' #FUNCTION# ====================================================================================================================
' Name...........: Fn3_ExtraitMail()
' Description ...: 'Extraire un mail depuis un contenu stocké en première ligne d'un tableau
'Le mail à retrouver est balisé entre les signes "<" et ">"
'permet d'extraire un mail selon le contenu au format texte, transmis en paramètre. 
' Syntax.........:  Fn3_ExtraitMail(ChaineDeCaracteres As String,Optional ByRef OutputInfo As String,Optional ByRef AvecCasse As Boolean) As String
' Parameters ....: $avArray - Array to modify
'                  $vValue  - Value to add
' Return values .: Success - Retourne string
'                  Failure - -1, sets @error
'                  |1 - $avArray is not an array
'                  |2 - $avArray is not a 1 dimensional array
' Author ........: martinbrait
' Modified.......:
' Remarks .......:
'l'argument optionnel de type string correspond au paramètre "nom","prenom", "messagerie"
'l'argument optionnel de type booléen 1 ou 0, correspond au paramètre casse optimisée.
' Related .......: 
' Link ..........;
' Example .......' Yes
' ===============================================================================================================================
    Function Fn3_ExtraitMail(ChaineDeCaracteres As String,Optional ByRef OutputInfo As String,Optional ByRef AvecCasse As Boolean) As String
    'fonctionne dans l'environnement Office, quelle que soit l'application soffice ouverte.
    Dim debutmail As Integer, finmail As Integer, longueurmail As Integer, positArobase As Integer
    Dim sprenom As String
    Dim FnIntegree As Object
       FnIntegree= CreateUnoService("com.sun.star.sheet.FunctionAccess")
       'on masque la balise de début de mail
       	If Fn2_CaractereExiste(ChaineDeCaracteres,"<")=True Then
	       	debutmail = FnIntegree.CallFunction("SEARCH",array("<",ChaineDeCaracteres,1))+1
	       	finmail = FnIntegree.CallFunction("SEARCH",array(">",ChaineDeCaracteres,1))
	       	longueurmail = finmail - debutmail
		   	temp = FnIntegree.CallFunction("MID",array(ChaineDeCaracteres,debutmail,longueurmail))

			   	If Fn2_CaractereExiste(temp,"@")=False Or Fn2_CaractereExiste(temp,".")=False Then
			   	temp = ""
			   	Else
			   	
					If IsMissing(OutputInfo) Then    'le traitement pour la chaîne contenant mail, bien identifiée.   
					       	Fn3_ExtraitMail = temp
					ElseIf OutputInfo = "nom" Then
						sprenom = Left(temp,Instr(1,temp,"."))
						positArobase = FnIntegree.CallFunction("SEARCH",array("@",temp,1))
						temp = Left(temp,positArobase-1)
						temp = Replace(temp,sprenom,"")
						
						If IsMissing(AvecCasse) Then
							Fn3_ExtraitMail = temp	
						ElseIf AvecCasse = True Then
							Fn3_ExtraitMail = UCase(temp)
						End If

					ElseIf OutputInfo = "prenom" Then
						sprenom = Left(temp,Instr(1,temp,".")-1)
						If IsMissing(AvecCasse) Then
							Fn3_ExtraitMail = sprenom
						ElseIf AvecCasse = True Then
							Fn3_ExtraitMail = Left(UCase(sprenom),1) & Right(sprenom,Len(sprenom)-1)
						End If						
					ElseIf OutputInfo = "messagerie" Then
					positArobase = FnIntegree.CallFunction("SEARCH",array("@",temp,1))
					temp = Right(temp,len(temp)-positArobase)
					Fn3_ExtraitMail=temp
					End If
									   	
				End If
			Else
			Fn3_ExtraitMail = ""
		End If

    End Function   
 

Merci et à bientôt.

[Jeff]

Merci de corriger "mail" par "courriel" dans ton titre

en suivant les recommandations de JEFF

Non, puisque tu continue à chercher une adresse courriel encadré par < et >, alors que je proposais :

une adresse de courriel peut être composée de lettres, chiffres, caractères spéciaux tel que point, tiret et underscore [...] on recherche jusqu’en début [...] fin de texte un caractère autre que ceux énumérés en vert ci-dessus

On y arrive par formule indigeste du type :

Code : Tout sélectionner

=SI(ESTERREUR(CHERCHE("@";A2));"";GAUCHE(DROITE(A2;1+NBCAR(A2)-CHERCHE("[a-z0-9\._\-]+@";A2));SI(ESTERREUR(CHERCHE("[^a-z^0-9^\.^_^\-^@]";DROITE(A2;1+NBCAR(A2)-CHERCHE("[a-z0-9\._\-]+@";A2))));NBCAR(DROITE(A2;1+NBCAR(A2)-CHERCHE("[a-z0-9\._\-]+@";A2)));CHERCHE("[^a-z^0-9^\.^_^\-^@]";DROITE(A2;1+NBCAR(A2)-CHERCHE("[a-z0-9\._\-]+@";A2)))-1)))

(formule non testée exhaustivement, nécessite l’activation des expressions régulières dans les formules)

martinbrait_indigeste.png

Quitte à avoir une macro, tu pourrai laisser libre cours à l’utilisateur de choisir les délimitation de l’adresse avec des arguments optionnels, par exemple.

[martinbrait]

Hello Jeff,

Ta combinaison d'expressions régulières est remarquable !

Voilà, j'ai apporté la petite amélioration, avec pseudo-expressions régulières
qui rend l'outil à peu près acceptable.

Merci et à bientôt.

[Piaf]

Bonsoir
Pas compris l'intérêt de délimiter l'adresse courriel par < >.
Pourquoi ne pas utiliser la fonction Split tout Simplement ?
Après l'histoire du Nom et prénom séparé par un point ?

Courriel.png

Code : Tout sélectionner

Function AdresseMel(Cell as String) as String
Dim Courriel() as String, i as Integer
	Courriel = Split(Cell," ")
	For i = 0 To UBound(Courriel)
		If instr(1,Courriel(i),"@") > 0 Then
			AdresseMel = Courriel(i)
			Exit For
		Else
			AdresseMel = ""	
		End If
	Next i
End Function

Function Nom(Cell as String) as String
	If Cell <> "" Then
		Nom = Split(Cell,"@")(0)
	Else
		Nom = ""
	End If	
End Function

Function Fournisseur(Cell as String) as String
	If Cell <> "" Then
		Fournisseur = Split(Cell,"@")(1)
	Else
		Fournisseur = ""
	End If		
End Function

A+

[martinbrait]

Bonjour Piaf,
C'est une bonne idée et un exemple de code bien écrit.

J'ai délimité les mails entre balise,
parce que je n'avais pas considéré que les espaces
étaient les délimiteurs naturels.

Si on fait un copier coller d'un carnet d'adresse de messagerie,
les balises <...> arrivent avec le mail.

Finalement, il est peut être utile
de Trimer sans distinction toute adresse mail
collectée, et l'épaufrer par principe, de ses potentielles "<", ">", "(", ")", "[", "]" etc...

Merci et à bientôt !