Creating Log Tables - Looped Email Cycle

[racer25]

Hi All,

I have a rather nice (if I do say so myself) DB that pulls data from our Oracle DB, runs various queries via VBA buttons and emails out using Outlook 4,000 + statements to our customers.

I would love to take credit but several bits of the code is recycled from here....

The challenge I have is that when it comes across a badly formed email address and we have several per month that Outlook rejects the address and the script stops.

What I would ideally like to do is skip the error but log the account number so the data can trapped but the program runs to the end uninterrupted.

The code below does the work attaching the statements to an email message and sending.

Can you please offer me some assistance is resolving this challenge.

Many thanks,

Rob

rivate Sub Command1_Click()

Dim rs As DAO.Recordset
Dim sql As String
Dim strPath As String
Dim x As Variant
Dim stDocName As String

Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment

x = [Forms]![Generate Statement]![Text10]


DoCmd.SetWarnings False

strPath = "C:\Temp\"
sql = "SELECT DISTINCT StatementTable.Terms, StatementTable.StateFile, StatementTable.Email, StatementTable.CLI_USERIDSERV, StatementTable.CLI_USERIDINBR,  StatementTable.CLI_CLIENTNUMBER, StatementTable.Salutation, StatementTable.SHD_ENDDATE FROM StatementTable;"
Set rs = CurrentDb().OpenRecordset(sql, dbOpenSnapshot)
Do While Not rs.EOF
    StateFile = rs!StateFile
    Email = rs!Email
    Salutation = rs!Salutation
    StateMonth = rs!SHD_ENDDATE
    Terms = rs!Terms
    strCLICode = rs!CLI_CLIENTNUMBER
    Servicer = rs!CLI_USERIDSERV
    Broker = rs!CLI_USERIDINBR
 
 
 
 'make new mail message
    
   
    SigString = "C:\Temp\Sig\IrlAccounts.htm"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

       
   
   ' Create the Outlook session.
   Set objOutlook = CreateObject("Outlook.Application")
    objOutlook.Session.Logon

   ' Create the message.
   Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

    Set OutApp = CreateObject("Outlook.Application")

   With objOutlookMsg
    If Not IsNull(Email) Then
        Set objOutlookRecip = .Recipients.Add(Email)
        objOutlookRecip.Type = olTo
    Else
        Set objOutlookRecip = .Recipients.Add("Blank@Blank.ie")
        objOutlookRecip.Type = olTo
    
    End If

      ' Set the Subject, Body, and Importance of the message.
      .Subject = "Client Statement Attached"
      .HTMLBody = "<SPAN STYLE='font: 8pt Verdana'>Dear " & Salutation & "<BR></BR><BR></BR>" & _
        "Please find attached your statement for " & MonthName(Month(StateMonth)) & " " & Year(StateMonth) & "." & "<BR></BR><BR></BR>" & _
        "The File - " & Terms & ".pdf" & " - contains additional supporting information and Terms & Conditions along with Bank Information." & "<BR></BR><BR></BR>" & _
        "If you wish to settle your account by Telegraphic Transfer please send details of your settlement to " & "<a href='mailto:bill@xxx.ie'>BILL@xxx.ie</a>" & " so we can allocate payment to your account promptly." & "<BR></BR><BR></BR>" & _
        "<b>" & "If you require copy invoices or wish to query anything on your account please send an email to " & "<a href='mailto:bill@xxx.ie'>bill@xxx.ie</a>" & "  ." & "</b>" & "<BR></BR><BR></BR>" & _
        "Kind Regards." & "<BR></BR><BR></BR>" & _
        "Accounts Dept." & "<BR></BR><BR></BR>" & _
        "</span>" & "<BR></BR>" & Signature & _
        "<SPAN STYLE='font: 8pt Verdana'>" & _
        "Client Code " & strCLICode & "<BR></BR>" & _
        "Account Manager " & Servicer & "<BR></BR>" & _
        "Broker " & Broker & "<BR></BR>" & _
         "</span>"


      .Importance = olImportanceHigh  'High importance
      
      ' Add attachments to the message.
      If Not IsMissing(AttachmentPath) Then
        AttachmentPath = "C:\Temp\" & StateFile & ".pdf"
        Set objOutlookAttach = .Attachments.Add(AttachmentPath)
        AttachmentPath = "C:\Temp\Bank\" & Terms & ".pdf"
        Set objOutlookAttach = .Attachments.Add(AttachmentPath)
      End If

      For Each objOutlookRecip In .Recipients
     
      Next
        x = x + TimeValue([Forms]![Generate Statement]![Text14])
        .DeferredDeliveryTime = x
        .SendUsingAccount = OutApp.Session.Accounts.Item(1)
        .Send

   End With
   Set objOutlookMsg = Nothing
   Set objOutlook = Nothing
   
    rs.MoveNext

Loop

MsgBox x & " Statement Emailed"

Set rs = Nothing

DoCmd.SetWarnings True

 

[jdraw]

Here is a simple email syntax checker you could include in your processing.

'---------------------------------------------------------------------------------------
' Procedure : EmailValidationSimple
' Author    : Jack
' Date      : 25-11-2011
' Purpose   : Routine to do a simple email format validation.
'             Note: The email may not be a valid email(doesn't exist), but its format/syntax is OK.
'
' Typical usage: 
'                 If  EmailValidationSimple(myEmailToCheck) then
'                     Valid do normal processing
'                 Else
'                     Failed validation go to Error Processing and skip this email
'                 End if
'---------------------------------------------------------------------------------------
' Last Modified:
'
' Inputs:  A string representing the email to be tested
' Returns:
'     True  if email syntax is OK
'     False if email syntax is NOT OK
' Dependency: N/A
'--------------------------------------------------------------------------
'
Function EmailValidationSimple(sEmailIn As String) As Boolean

10       On Error GoTo EmailValidationSimple_Error

20    If (sEmailIn Like "*?@?*.?*" And _
      Not (sEmailIn Like "*[ ,;]*")) Then
30    EmailValidationSimple = True
40    Else
50    EmailValidationSimple = False
60    End If

70       On Error GoTo 0
80       Exit Function

EmailValidationSimple_Error:

90        MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure EmailValidationSimple"

End Function

 

[racer25]

Hi jdraw,

Thanks for taking a look at this.

Am I correct in thinking that this would only tell me that a message had failed but not tell me which message nor log the error's.

I like the idea of being able to log the error's and thus hand someone a list and say "fix this".

I could run the script against the table beforehand but as a test it only picked up around 40% of the failures - (we have some rather unskillful data entry folks).

Thanks again,

Rob

 

[jdraw]

As I mentioned here

' Typical usage:
' If EmailValidationSimple(myEmailToCheck) then
' Valid do normal processing
' Else
' Failed validation go to Error Processing and skip this email
' End if

You would have your general processing.
Before you create your email, you would check the value of the email field in your record. If the email value passes the validation, process it and send the email. If the email value fails the validation, then write that record or email address or whatever you want to record to a table or a file.

Going back to your code sample.

You would put a label before the rs.movenext
Something like
SkipToHere:
rs.MoveNext

Then in your
Do While Not rs.EOF loop

you would do a check

if EmailValidationSimple(rs!email) = False then

'this is where you write the bad email to a table
'then skip to get another record
GOTO SkipToHere
else
'there is no code needed here, just process this existing record
'since the rs!email value is valid
end if