I have a database of emails that I am work with to send our clients pertinant information. My problem is that some clients have multiple email address all croweded into a single field.
I have created a program that checks each individual character to assure that it is a properly set up database I.E. Name.Name@server.ext This has caught quiet a few emails that are would not send. I believe I can modify this program to break down the multi emails in a field to single emails to a field. However, I am not sure how to copy the field of an extracted email to a proper field and record. Any help with this is greatly appreciated.
The program to extract the emails, check their extensions and mark them as good or bad is...
Option Compare Database
Option Explicit
'SET CRITERIA TO OPEN EMAIL_CHECK_LIST FORM
Private Sub Form_Open(Cancel As Integer)
'DEFINE VARIABLES
Dim DB As DAO.Database
Dim rs As DAO.Recordset
Dim Place As Integer 'Counts the number of places in the Email Field
Dim RecCount As Integer, RecTotal As Integer
Dim Cnt As Integer, Cntr As Integer
Dim Hold As String 'Builds Single Email
Dim ChkIt As String 'Checks the Character of the Email Field for ;
Dim Chk As String
'SET DATABASE AND OPEN RECORDSET
Set DB = CurrentDb
Set rs = DB.OpenRecordset("Email_Only_List")
'SET TOTAL RECORDS, RECORD COUNT AND GOTO FIRST RECORD OF RECORDSET
Me.Recordset.MoveLast
RecTotal = Me.Recordset.RecordCount
RecCount = 0
Me.Recordset.MoveFirst
'GO THROUGH EACH RECORD INDIVIDUALLY
Do While RecCount < RecTotal
Place = 0
Cnt = 90
Cntr = 0
Hold = ""
'CHECK EACH CHARACTER IN FIELD
Do Until Cntr = Cnt
Cntr = Cntr + 1
Place = Place + 1
ChkIt = Mid(Email, Place, 1)
'CHECK FOR ENDING OF EMAIL ADDRESS OR FIELD
Select Case ChkIt
Case ";"
EmailCheck (Hold)
'END OF EMAIL IF ; VERIFY EMAIL TO BE GOOD OR BAD
Case ""
EmailCheck (Hold)
'END OF FIELD IF ' ' VERIFY EMAIL TO BE GOOD OR BAD
Exit Do
Case Else
Hold = Hold + ChkIt
'INCREMENT VARIABLE AND CHECK NEXT CHARACTER
End Select
Loop
'INCREMENT COUNT AND GO TO NEXT RECORD
RecCount = RecCount + 1
Me.Recordset.MoveNext
Loop
'CLOSE EMAIL_CHECK_LIST FORM AND OPEN BAD_EMAIL_FRM TO CHECK ON ERRORS
DoCmd.Close
DoCmd.OpenForm "Bad_Email_frm"
End Sub
'VERIFY EMAIL AS GOOD OR BAD
Private Sub EmailCheck(Hold)
On Error GoTo Err_Handle_Click
Dim ChkIt As String
ChkIt = Right(Hold, 3)
Select Case ChkIt
Case ".md"
'Passes Through, Does Nothing
Case ".us"
'Passes Through, Does Nothing
Case "Com"
'Passes Through, Does Nothing
Case "edu"
'Passes Through, Does Nothing
Case "gov"
'Passes Through, Does Nothing
Case "mil"
'Passes Through, Does Nothing
Case "net"
'Passes Through, Does Nothing
Case "org"
'Passes Through, Does Nothing
Case Else (I am thinking that at this point is where I create the new field in the new record)
'IF NOT MARKED AS BAD THEN MARK AS BAD, ELSE END IF
If Chk = 0 Then
Forms!Email_Check_List.Chk = -1
End If
End Select
Exit_Finish_Up_Click:
Exit Sub
Err_Handle_Click:
MsgBox Err.Description
Resume Exit_Finish_Up_Click
End Sub
Thank you for your help with this program.
Robert M
I have created a program that checks each individual character to assure that it is a properly set up database I.E. Name.Name@server.ext This has caught quiet a few emails that are would not send. I believe I can modify this program to break down the multi emails in a field to single emails to a field. However, I am not sure how to copy the field of an extracted email to a proper field and record. Any help with this is greatly appreciated.
The program to extract the emails, check their extensions and mark them as good or bad is...
Option Compare Database
Option Explicit
'SET CRITERIA TO OPEN EMAIL_CHECK_LIST FORM
Private Sub Form_Open(Cancel As Integer)
'DEFINE VARIABLES
Dim DB As DAO.Database
Dim rs As DAO.Recordset
Dim Place As Integer 'Counts the number of places in the Email Field
Dim RecCount As Integer, RecTotal As Integer
Dim Cnt As Integer, Cntr As Integer
Dim Hold As String 'Builds Single Email
Dim ChkIt As String 'Checks the Character of the Email Field for ;
Dim Chk As String
'SET DATABASE AND OPEN RECORDSET
Set DB = CurrentDb
Set rs = DB.OpenRecordset("Email_Only_List")
'SET TOTAL RECORDS, RECORD COUNT AND GOTO FIRST RECORD OF RECORDSET
Me.Recordset.MoveLast
RecTotal = Me.Recordset.RecordCount
RecCount = 0
Me.Recordset.MoveFirst
'GO THROUGH EACH RECORD INDIVIDUALLY
Do While RecCount < RecTotal
Place = 0
Cnt = 90
Cntr = 0
Hold = ""
'CHECK EACH CHARACTER IN FIELD
Do Until Cntr = Cnt
Cntr = Cntr + 1
Place = Place + 1
ChkIt = Mid(Email, Place, 1)
'CHECK FOR ENDING OF EMAIL ADDRESS OR FIELD
Select Case ChkIt
Case ";"
EmailCheck (Hold)
'END OF EMAIL IF ; VERIFY EMAIL TO BE GOOD OR BAD
Case ""
EmailCheck (Hold)
'END OF FIELD IF ' ' VERIFY EMAIL TO BE GOOD OR BAD
Exit Do
Case Else
Hold = Hold + ChkIt
'INCREMENT VARIABLE AND CHECK NEXT CHARACTER
End Select
Loop
'INCREMENT COUNT AND GO TO NEXT RECORD
RecCount = RecCount + 1
Me.Recordset.MoveNext
Loop
'CLOSE EMAIL_CHECK_LIST FORM AND OPEN BAD_EMAIL_FRM TO CHECK ON ERRORS
DoCmd.Close
DoCmd.OpenForm "Bad_Email_frm"
End Sub
'VERIFY EMAIL AS GOOD OR BAD
Private Sub EmailCheck(Hold)
On Error GoTo Err_Handle_Click
Dim ChkIt As String
ChkIt = Right(Hold, 3)
Select Case ChkIt
Case ".md"
'Passes Through, Does Nothing
Case ".us"
'Passes Through, Does Nothing
Case "Com"
'Passes Through, Does Nothing
Case "edu"
'Passes Through, Does Nothing
Case "gov"
'Passes Through, Does Nothing
Case "mil"
'Passes Through, Does Nothing
Case "net"
'Passes Through, Does Nothing
Case "org"
'Passes Through, Does Nothing
Case Else (I am thinking that at this point is where I create the new field in the new record)
'IF NOT MARKED AS BAD THEN MARK AS BAD, ELSE END IF
If Chk = 0 Then
Forms!Email_Check_List.Chk = -1
End If
End Select
Exit_Finish_Up_Click:
Exit Sub
Err_Handle_Click:
MsgBox Err.Description
Resume Exit_Finish_Up_Click
End Sub
Thank you for your help with this program.
Robert M