Opgelost Ongeldige mail adressen verwijderen (indien geen @ of .com / .nl)

[trainers]

Zie bijlage. Alleen fictieve namen (Aap, Noot, Mies etc.)

E-mail adressen in een ledenlijst geven een "gevarieerd" beeld, van lege cel, 0, een - dan wel zonder @. Ook verschillende formats.
Hoe verwijder ik de ongeldige mailadressen?

Korte toelichting op de bedoeling:
Als ik in een kolom alleen geldige mail adressen heb kan ik deze (komma gescheiden) in een cel zetten. Vervolgens copy/paste in de BCC en ik ben klaar. Uiteraard ook eerst de hyperlinks verwijderen. Dit lukt prima via VBA.

Maar nu die ongeldige mailadressen verwijderen.

Bij voorbaat dank.
Groet,
Trainers

 

[AlexCEL]

Als je Excel 365 gebruikt kan deze:

=FILTER(A2:A17;(LENGTE(A2:A17)-LENGTE(SUBSTITUEREN(SUBSTITUEREN(A2:A17;"@";"");".";"")))=2;"")

Mocht je geen Excel 365 hebben, dan kun je deze achter de kolom met e-mail adressen zetten en daarna hierop filteren:

=ALS(LENGTE(A2)-LENGTE(SUBSTITUEREN(SUBSTITUEREN(A2;"@";"");".";""))=2;"geldig e-mail adres";"")

Power Query is ook nog wel een optie.

 

[AlexCEL]

Hier nog voorbeeldje.

 

[JEC.]

Er zijn wel meer varianten van geldige email adressen. Deze zou nu als correct naar voren komen

xy.z@ghotmail

 

[AHulpje]

Als je toch met VBA bezig bent, met een UDF die je eventueel makkelijk kunt uitbreiden:

Function GeldigEmailadres(emailadres) As Boolean
    'bevat een @, maar niet op de eerste positie
    'bevat geen spaties
    'eindigt op .nl of .com (meestal zo in Nederland)
    'moet tussen @ en . minimaal 1 karakter bevatten
    If InStr(emailadres, "@") > 1 And _
        InStr(emailadres, " ") < 1 And _
        (Right(emailadres, 3) = ".nl" Or Right(emailadres, 4) = ".com") And _
        InStr(emailadres, "@.") < 1 Then
        GeldigEmailadres = True
    End If
End Function

 

[edmoor]

Ik gebruik deze:

Public Function ValidateEmailAddress(ByVal strEmailAddress As String) As Boolean
    On Error GoTo Foutje
    
    Dim objRegExp As New RegExp
    Dim blnIsValidEmail As Boolean
    
    objRegExp.IgnoreCase = True
    objRegExp.Global = True
    objRegExp.Pattern = "^([a-zA-Z0-9_\-\.]+)@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,3})$"
    
    blnIsValidEmail = objRegExp.Test(strEmailAddress)
    ValidateEmailAddress = blnIsValidEmail
      
    Exit Function
    
Foutje:
    ValidateEmailAddress = False
End Function

 

[AlexCEL]

Er zijn wel meer varianten van geldige email adressen. Deze zou nu als correct naar voren komen

xy.z@ghotmail

Klopt. 100% garantie is het niet, mag TS zeggen of dit vaak voorkomt en dus een probleem is.

 

[edmoor]

Bij mij komt 'ie als ongeldig terug.

 

[AHulpje]

Bij gebruik van Regular Expressions wel even een verwijzing naar Microsoft VBScript Regular Expressions toevoegen.

 

[JEC.]

Ik zou ook voor regular expression gaan

Sub jecc()
 Dim xReg, ar, j As Long, x As Long
 Set xReg = CreateObject("vbscript.regexp")
 With Range("A2").CurrentRegion.Offset(1)
   ar = .Value
   ReDim a(UBound(ar), 0)
   For j = 2 To UBound(ar)
     xReg.Global = True
     xReg.ignorecase = True
     xReg.Pattern = "([a-z0-9_\-\.]+)@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,3})"
     If xReg.test(ar(j, 1)) Then a(x, 0) = xReg.Execute(ar(j, 1))(0): x = x + 1
   Next
  .ClearContents
  .Resize(x) = a
 End With
End Sub

 

[HSV]

Soortgelijk.

Sub hsv()
Dim sv, c As Range, i As Long, n As Long
Set c = Range("a2", Cells(Rows.Count, 1).End(xlUp))
sv = c.Value
With CreateObject("VBscript.Regexp")
 For i = 2 To UBound(sv)
       .Global = True
       .ignorecase = True
       .Pattern = "([a-z0-9_\-\.]+)@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,3})"
   If .test(sv(i, 1)) Then
      n = n + 1
     sv(n, 1) = sv(i, 1)
   End If
 Next
End With
c.ClearContents
Cells(2,1).Resize(n) = sv
End Sub

 

[JEC.]

Of als je direct alles op mail wilt zetten

Sub jec()
 Dim xReg, it
 Set xReg = CreateObject("vbscript.regexp")
 With CreateObject("outlook.application").createitem(0)
   For Each it In Range("A1").CurrentRegion.Columns(1).Cells
      xReg.Global = True
      xReg.ignorecase = True
      xReg.Pattern = "([a-z0-9_\-\.]+)@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,3})"
      If xReg.test(it) Then .bcc = .bcc & ";" & xReg.Execute(it)(0)
   Next
   .display
  End With
End Sub

 

[AHulpje]

Toch liever bcc dan to in het kader van de AVG

 

[trainers]

Wow, dat wordt studeren. Dank jullie wel.

@AlexCEL: de exceptionele varianten komen sporadisch voor. Meeste zijn een lege cel dan wel het - teken.

 

[AlexCEL]

Ik vond deze nog:

=ALS(EN(
 ISFOUT(VIND.ALLES(" ";A2));
 LENGTE(A2)-LENGTE(SUBSTITUEREN(A2;"@";""))=1;
 ALS.FOUT(VIND.SPEC("@";A2)<VIND.SPEC(".";A2;VIND.SPEC("@";A2));0);
 ISFOUT(VIND.ALLES(",";A2));
 NIET(ALS.FOUT(VIND.SPEC(".";A2;VIND.SPEC("@";A2))-VIND.SPEC("@";A2);0)=1);
 LINKS(A2;1)<>".";
 RECHTS(A2;1)<>".");
"ja";"nee")

Deze controleert de tekst op:
1. geen spaties;
2. aanwezigheid @-teken;
3. punt na het @-teken;
4. geen komma's;
5. punt niet direct na het @-teken;
6. start niet met een punt;
7. eindigt niet met een punt.

Volgens mij het je dan de meest voorkomende fouten wel ondervangen...

N.B. In Excel 365 kan het ietsje korter:

=LET(a;A2;x;VIND.SPEC("@";a);y;VIND.SPEC(".";a;x);ALS(EN(ISFOUT(VIND.ALLES(" ";a));LENGTE(a)-LENGTE(SUBSTITUEREN(a;"@";""))=1;ALS.FOUT(x<y;0);ISFOUT(VIND.ALLES(",";a));NIET(ALS.FOUT(VIND.SPEC(".";a;x)-x;0)=1);LINKS(a;1)<>".";RECHTS(a;1)<>".");"ja";"nee"))

 

[trainers]

Eindelijk weer wat tijd om met Excel te "spelen". Dank voor alle bijdragen.
Laatste formules van AlexCEL zijn ook wel formidabel!
Ben toch gegaan voor de VBA variant van HSV.

Allen nogmaals bedankt.

Groet,
Trainers