What if invalid email address?

[worksfire1]

I have a pretty slick piece of code that generates hundreds of custom access
reports and sends to individual users all at the click of a button. But what
happens when one of those hundreds of users in a list that grows every day,
has an invalid email address? It bombs my code out and I have to figure out
where to start the loop manually to send after I figure out which user/email
address is invalid!!! What do I need to add to the code below to allow the
loop to continue through for all the valid email address/users, but display
and not send the emails with invalid recipients? I am not a coder by any
means.

Private Sub EmailProposedAEClinicalAND1stStalledCustomRpts_Click()
Dim db As Database
Dim sqlstr As String
Dim sqlstr2 As String
Dim rscriteria As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim qdf2 As DAO.QueryDef

Set db = CurrentDb
Set rscriteria = db.OpenRecordset("qrytestusers", dbOpenDynaset)
rscriteria.MoveFirst

Do Until rscriteria.EOF

sqlstr = "select * from [_1stStalled-Proposed-MasterList] where [AE login
id]= '" & rscriteria![login id] & "'"
sqlstr2 = "select * from [ClinicalFPU-Proposed-MasterList] where [AE login
id]= '" & rscriteria![login id] & "'"

db.QueryDefs.Delete "Proposed_1st_Stalled_Cycle"
Set qdf = db.CreateQueryDef("Proposed_1st_Stalled_Cycle", sqlstr)

db.QueryDefs.Delete "Proposed_Clinical_Review_FPU"
Set qdf2 = db.CreateQueryDef("Proposed_Clinical_Review_FPU", sqlstr2)

If (DCount("[AE login id]", "Proposed_1st_Stalled_Cycle") > 0) Or
(DCount("[AE login id]", "Proposed_Clinical_Review_FPU") > 0) Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"Proposed_1st_Stalled_Cycle", "\\zion\databases\FPU\Proposed Clinical Review
FPU & 1st Stalled Cycle Report.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"Proposed_Clinical_Review_FPU", "\\zion\databases\FPU\Proposed Clinical
Review FPU & 1st Stalled Cycle Report.xls"

Dim EmailApp, NameSpace, EmailSend As Object

Set EmailApp = CreateObject("Outlook.Application")
Set NameSpace = EmailApp.GetNamespace("MAPI")
Set EmailSend = EmailApp.CreateItem(0)

EmailSend.To = rscriteria![login id]
EmailSend.CC =
"k34260;greeng;broomeje;kalea;mckinnee;holtch;huntera"
EmailSend.Subject = "Proposed Clinical Review FPU & 1st
Stalled Cycle Report w/e 07/30/07"
EmailSend.Body = "Good Morning! Please review the attached
Excel file that contains your personal Proposed Clinical FPU & 1st Stalled
items for w/e 08/06/07 where you are the AE assigned. Please direct
feedback on the new personalized report to your manager. If you have any
questions, please don’t hesitate to contact me at extension 71382 or Jennifer
Broome at extension 71432"
EmailSend.Attachments.Add "\\Zion\Databases\FPU\Proposed
Clinical Review FPU & 1st Stalled Cycle Report.xls"
EmailSend.Display

Set EmailApp = Nothing
Set NameSpace = Nothing
Set EmailSend = Nothing

End If

continueToNext:
rscriteria.MoveNext
Loop
rscriteria.Close

MsgBox "Process complete."

End Sub

 

[pietlinden]

why not create a function that uses a regular expression to validate
the e-mail address? Then do something like this...

do until rs.EOF
if IsValidEMail(rs.Fields("EMail")) Then
'send the e-mail
Else
'do something else, like set teh valid flag of the record to
false?
End if
rs.MoveNext
Loop

 

[John Nurick]

Does this code actually send the messages? I thought that
MailItem.Display simply displayed the message in a window where you
can edit it or send it. If you use .Send instead of .Display you
should get a trappable error if Outlook can't interpret the contents
of .To as a plausible address.

Speaking for myself, I'd be inclined to use CDO or CDONTS rather than
automating Outlook itself: much less overhead.

And of course there's often no practical way of telling whether an
email message is "valid" - in the sense of pointing to a mailbox that
is read by the intended recipient - short of sending a message and
waiting for the reply!

I have a pretty slick piece of code that generates hundreds of custom access
reports and sends to individual users all at the click of a button. But what
happens when one of those hundreds of users in a list that grows every day,
has an invalid email address? It bombs my code out and I have to figure out
where to start the loop manually to send after I figure out which user/email
address is invalid!!! What do I need to add to the code below to allow the
loop to continue through for all the valid email address/users, but display
and not send the emails with invalid recipients? I am not a coder by any
means.

Private Sub EmailProposedAEClinicalAND1stStalledCustomRpts_Click()
Dim db As Database
Dim sqlstr As String
Dim sqlstr2 As String
Dim rscriteria As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim qdf2 As DAO.QueryDef

Set db = CurrentDb
Set rscriteria = db.OpenRecordset("qrytestusers", dbOpenDynaset)
rscriteria.MoveFirst

Do Until rscriteria.EOF

sqlstr = "select * from [_1stStalled-Proposed-MasterList] where [AE login
id]= '" & rscriteria![login id] & "'"
sqlstr2 = "select * from [ClinicalFPU-Proposed-MasterList] where [AE login
id]= '" & rscriteria![login id] & "'"

db.QueryDefs.Delete "Proposed_1st_Stalled_Cycle"
Set qdf = db.CreateQueryDef("Proposed_1st_Stalled_Cycle", sqlstr)

db.QueryDefs.Delete "Proposed_Clinical_Review_FPU"
Set qdf2 = db.CreateQueryDef("Proposed_Clinical_Review_FPU", sqlstr2)

If (DCount("[AE login id]", "Proposed_1st_Stalled_Cycle") > 0) Or
(DCount("[AE login id]", "Proposed_Clinical_Review_FPU") > 0) Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"Proposed_1st_Stalled_Cycle", "\\zion\databases\FPU\Proposed Clinical Review
FPU & 1st Stalled Cycle Report.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"Proposed_Clinical_Review_FPU", "\\zion\databases\FPU\Proposed Clinical
Review FPU & 1st Stalled Cycle Report.xls"

Dim EmailApp, NameSpace, EmailSend As Object

Set EmailApp = CreateObject("Outlook.Application")
Set NameSpace = EmailApp.GetNamespace("MAPI")
Set EmailSend = EmailApp.CreateItem(0)

EmailSend.To = rscriteria![login id]
EmailSend.CC =
"k34260;greeng;broomeje;kalea;mckinnee;holtch;huntera"
EmailSend.Subject = "Proposed Clinical Review FPU & 1st
Stalled Cycle Report w/e 07/30/07"
EmailSend.Body = "Good Morning! Please review the attached
Excel file that contains your personal Proposed Clinical FPU & 1st Stalled
items for w/e 08/06/07 where you are the AE assigned. Please direct
feedback on the new personalized report to your manager. If you have any
questions, please don’t hesitate to contact me at extension 71382 or Jennifer
Broome at extension 71432"
EmailSend.Attachments.Add "\\Zion\Databases\FPU\Proposed
Clinical Review FPU & 1st Stalled Cycle Report.xls"
EmailSend.Display

Set EmailApp = Nothing
Set NameSpace = Nothing
Set EmailSend = Nothing

End If

continueToNext:
rscriteria.MoveNext
Loop
rscriteria.Close

MsgBox "Process complete."

End Sub

 

[SteveM]

You just want to validte the email address so Outlook doesn't reject it?
It must be at least 6 characters, have an @ sign and at least one '.' dot.

Something like this should work for you:

Do Until rscriteria.EOF
If Len(rscriteria![login id]) > 6 And InStr(1, rscriteria![login id], "@") >
1 And InStr(1, rscriteria![login id], ".") > 1 Then

'[Rest of your code]

End If

rscriteria.MoveNext
Loop


That will at least check that it passes as a valid email address but it
doesn't mean that email address actually exists!

Steve

I have a pretty slick piece of code that generates hundreds of custom access
reports and sends to individual users all at the click of a button. But what
happens when one of those hundreds of users in a list that grows every day,
has an invalid email address? It bombs my code out and I have to figure out
where to start the loop manually to send after I figure out which user/email
address is invalid!!! What do I need to add to the code below to allow the
loop to continue through for all the valid email address/users, but display
and not send the emails with invalid recipients? I am not a coder by any
means.

Private Sub EmailProposedAEClinicalAND1stStalledCustomRpts_Click()
Dim db As Database
Dim sqlstr As String
Dim sqlstr2 As String
Dim rscriteria As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim qdf2 As DAO.QueryDef

Set db = CurrentDb
Set rscriteria = db.OpenRecordset("qrytestusers", dbOpenDynaset)
rscriteria.MoveFirst

Do Until rscriteria.EOF

sqlstr = "select * from [_1stStalled-Proposed-MasterList] where [AE login
id]= '" & rscriteria![login id] & "'"
sqlstr2 = "select * from [ClinicalFPU-Proposed-MasterList] where [AE login
id]= '" & rscriteria![login id] & "'"

db.QueryDefs.Delete "Proposed_1st_Stalled_Cycle"
Set qdf = db.CreateQueryDef("Proposed_1st_Stalled_Cycle", sqlstr)

db.QueryDefs.Delete "Proposed_Clinical_Review_FPU"
Set qdf2 = db.CreateQueryDef("Proposed_Clinical_Review_FPU", sqlstr2)

If (DCount("[AE login id]", "Proposed_1st_Stalled_Cycle") > 0) Or
(DCount("[AE login id]", "Proposed_Clinical_Review_FPU") > 0) Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"Proposed_1st_Stalled_Cycle", "\\zion\databases\FPU\Proposed Clinical Review
FPU & 1st Stalled Cycle Report.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"Proposed_Clinical_Review_FPU", "\\zion\databases\FPU\Proposed Clinical
Review FPU & 1st Stalled Cycle Report.xls"

Dim EmailApp, NameSpace, EmailSend As Object

Set EmailApp = CreateObject("Outlook.Application")
Set NameSpace = EmailApp.GetNamespace("MAPI")
Set EmailSend = EmailApp.CreateItem(0)

EmailSend.To = rscriteria![login id]
EmailSend.CC =
"k34260;greeng;broomeje;kalea;mckinnee;holtch;huntera"
EmailSend.Subject = "Proposed Clinical Review FPU & 1st
Stalled Cycle Report w/e 07/30/07"
EmailSend.Body = "Good Morning! Please review the attached
Excel file that contains your personal Proposed Clinical FPU & 1st Stalled
items for w/e 08/06/07 where you are the AE assigned. Please direct
feedback on the new personalized report to your manager. If you have any
questions, please don’t hesitate to contact me at extension 71382 or Jennifer
Broome at extension 71432"
EmailSend.Attachments.Add "\\Zion\Databases\FPU\Proposed
Clinical Review FPU & 1st Stalled Cycle Report.xls"
EmailSend.Display

Set EmailApp = Nothing
Set NameSpace = Nothing
Set EmailSend = Nothing

End If

continueToNext:
rscriteria.MoveNext
Loop
rscriteria.Close

MsgBox "Process complete."

End Sub