Autres fonction GetEmailAdress...

guizmo77 · 6 Février 2023

Hello,
j'ai chopé ce code sur un site et il a très bien fonctionné sur un fichier. Or quand je veux le dupliquer sur un autre, rien ne se passe et j'ai l'erreur #NOM?. Vous pouvez m'aider? Merci!

Function GetEmailAddress(ByVal S As String) As String
Dim X As Long, AtSign As Long
Dim Locale As String, DomainPart As String
Locale = "[A-Za-z0-9.!#$%&'*/=?^_`{|}~+-]"
Domain = "[A-Za-z0-9._-]"
AtSign = InStr(S, "@")
For X = AtSign To 1 Step -1
If Not Mid(" " & S, X, 1) Like Locale Then
S = Mid(S, X)
If Left(S, 1) = "." Then S = Mid(S, 2)
Exit For
End If
Next
AtSign = InStr(S, "@")
For X = AtSign + 1 To Len(S) + 1
If Not Mid(S & " ", X, 1) Like Domain Then
S = Left(S, X - 1)
If Right(S, 1) = "." Then S = Left(S, Len(S) - 1)
GetEmailAddress = S

TooFatBoy · 6 Février 2023

Bonjour,

Il manque la fin de ta fonction.

Et n'hésite pas à utiliser la balise code=vb et à indenter ton code, pour le rendre plus lisible dans tes messages.

VB:

Function GetEmailAddress(ByVal S As String) As String
'
Dim X As Long, AtSign As Long
Dim Locale As String, DomainPart As String

    Locale = "[A-Za-z0-9.!#$%&'*/=?^_`{|}~+-]"
    Domain = "[A-Za-z0-9._-]"

    AtSign = InStr(S, "@")
    For X = AtSign To 1 Step -1
        If Not Mid(" " & S, X, 1) Like Locale Then
            S = Mid(S, X)
            If Left(S, 1) = "." Then S = Mid(S, 2)
            Exit For
        End If
    Next X

    AtSign = InStr(S, "@")
    For X = AtSign + 1 To Len(S) + 1
        If Not Mid(S & " ", X, 1) Like Domain Then
            S = Left(S, X - 1)
            If Right(S, 1) = "." Then S = Left(S, Len(S) - 1)
            GetEmailAddress = S

Bernard_XLD · 6 Février 2023

Bonjour guizmo77, le forum [édition : bonjour TooFatBoy]

je dirai qu'il manque des choses dans votre code posté
pas de End Function pour fermer la fonction

guizmo77 à dit:
For X = AtSign + 1 To Len(S) + 1

cette boucle for n'a pas de next

guizmo77 à dit:
If Not Mid(S & " ", X, 1) Like Domain Then

ce If n'a pas de End If

guizmo77 à dit:
DomainPart As String

cette variable n'est pas utilisée

guizmo77 à dit:
Domain = "[A-Za-z0-9._-]"

celle ci n'est pas déclarée, sans doute une erreur de modification

commencez par mettre votre code entre balises qu'on puisse voir si c'est une erreur de copie ou postez un fichier exemple.
vous pouvez aussi faire un débogage après avoir mis Option Explicit en tête du module

Cordialement, @+

guizmo77 · 7 Février 2023

Merci pour vos premiers retours, voici le code balisé:

VB:

Function GetEmailAddress(ByVal S As String) As String
Dim X As Long, AtSign As Long
Dim Locale As String, DomainPart As String
Locale = "[A-Za-z0-9.!#$%&'*/=?^_`{|}~+-]"
Domain = "[A-Za-z0-9._-]"
AtSign = InStr(S, "@")
For X = AtSign To 1 Step -1
If Not Mid(" " & S, X, 1) Like Locale Then
S = Mid(S, X)
If Left(S, 1) = "." Then S = Mid(S, 2)
Exit For
End If
Next
AtSign = InStr(S, "@")
For X = AtSign + 1 To Len(S) + 1
If Not Mid(S & " ", X, 1) Like Domain Then
S = Left(S, X - 1)
If Right(S, 1) = "." Then S = Left(S, Len(S) - 1)
GetEmailAddress = S
Exit For
End If
Next
End Function

TooFatBoy · 7 Février 2023

guizmo77 à dit:
quand je veux le dupliquer sur un autre, rien ne se passe et j'ai l'erreur #NOM?.

Je n'ai pas constaté ce problème chez moi. Mais ça vient peut-être de la chaîne passée à la fonction ?

Bernard_XLD · 7 Février 2023

Bonsoir guizmo77, TooFatBoy, le forum

Pas de problème chez moi non plus.
l'erreur #NOM? veut dire qu'il ne trouve pas la fonction, par hasard, ne l'auriez vous pas placé dans un module de feuille, dans le module ThisWorkbook ou dans un module standard défini avec Option Private Module en tête de module ?
les macros sont bien activées ? impératif pour utiliser une fonction personnalisée.

Cordialement, @+

TooFatBoy · 7 Février 2023

Bernard_XLD à dit:
l'erreur #NOM? veut dire qu'il ne trouve pas la fonction, par hasard, ne l'auriez vous pas placé dans un module de feuille, dans le module ThisWorkbook ou dans un module standard défini avec Option Private Module en tête de module ?

En effet.

Autres fonction GetEmailAdress...

guizmo77

XLDnaute Nouveau

TooFatBoy

XLDnaute Barbatruc

Bernard_XLD

XLDnaute Barbatruc

guizmo77

XLDnaute Nouveau

TooFatBoy

XLDnaute Barbatruc

Bernard_XLD

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

Discussions similaires