Programmatically creating email, checking if exists

M

Memento

Hello Guys,

I'm trying to create (automatically) an email from a filled in sur- and
lastname. Because a email could exists upon creating a new record, i'm
checking if it exists, if it does, it should use another format. I have
created three ways: in case of longer names that could be, for example:
(e-mail address removed), (e-mail address removed) or
(e-mail address removed).

Somehow it doesn't work as supposed to be. It does write down the email in
the correct format: (e-mail address removed), but if I try to create a
second user with the same name (which could be), it keeps on creating
dirk.the.winner@...

I'm now guessing i'm doing this completely wrong... :-s...

Suggestions?

The code i've written for it:

Private Sub txtLastName_AfterUpdate()
If Not IsNull(txtSurName) And Not IsNull(txtLastName) Then
txtEmail = (LCase(txtSurName) & "." & ReplaceWithDots(LCase(txtLastName)
& "@emmaus.be"))
If DCount("*", "Users", "Logonnaam = '" & txtEmail & "'") = 0 Then
bldAddEmail = True
End If
txtEmail = (LCase(txtSurName) & "" & GetRidOfSpaces(LCase(txtLastName) &
"@emmaus.be"))
If DCount("*", "Users", "Logonnaam = '" & txtEmail & "'") = 1 Then
blnAddEmail = True
Else
txtEmail = (LCase(txtSurName) & "." &
GetRidOfSpaces(LCase(txtLastName) & "@emmaus.be"))
blnAddEmail = True
End If
End If

If blnAddEmail Then
' is Form based on the [Users] table?
Me! = txtEmail
Cancel = False
End If
End Sub

Public Function GetRidOfSpaces(TextIn)
GetRidOfSpaces = Replace(TextIn, " ", "")
End Function

Public Function ReplaceWithDots(TextIn)
ReplaceWithDots = Replace(TextIn, " ", ".")
End Function
 
B

Bill Manville

Private Sub txtLastName_AfterUpdate()
If Not IsNull(txtSurName) And Not IsNull(txtLastName) Then
txtEmail = (LCase(txtSurName) & "." & ReplaceWithDots(LCase(txtLastName)
& "@emmaus.be"))
If DCount("*", "Users", "Logonnaam = '" & txtEmail & "'") = 0 Then
bldAddEmail = True
Else ' <<<<<this line is changed
txtEmail = (LCase(txtSurName) & "" & GetRidOfSpaces(LCase(txtLastName) &
"@emmaus.be"))
If DCount("*", "Users", "Logonnaam = '" & txtEmail & "'") = 1 Then
blnAddEmail = True
Else
txtEmail = (LCase(txtSurName) & "." &
GetRidOfSpaces(LCase(txtLastName) & "@emmaus.be"))
blnAddEmail = True
End If
End If ' <<<<<this line is new
End If

Bill Manville
MVP - Microsoft Excel, Oxford, England
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top