Sending email fails

[cebrower]

I use the following code to loop through a table and email invoices to customers. What is a good way to handle an error if the "To" email address is invalid? As it is now the routine chokes at mi.send. Sometimes the sender gets a bounce message in her inbox, but sometimes the program just crashes.

Private Sub SendMail()


Dim InvToSend As String
Dim Sig As String
Dim Sig2 As String


InvToSend = "e:\EmailedInvoices" & varInvoiceNumber & ".pdf"
Sig = Environ("appdata") & "\Microsoft\Signatures"
Sig2 = Sig & Dir$(Signature & "*.htm")


Dim outl As Outlook.Application
Set outl = New Outlook.Application
Dim mi As Outlook.MailItem
Set mi = outl.CreateItem(olMailItem)


mi.Attachments.Add ("e:\EmailedInvoices" & varInvoiceNumber & ".pdf")
mi.HTMLBody = "Please see the attached invoice for your recent order." & "<br />" & "<br />" _
& "Thank you," & "<br />" & "<br />" & "Lori Meyer" & "<br />" & "Accounting Manager" & "<br />" _
& "Our Company, Inc." & "<br />" & "Accountant@OurCompany.com"
mi.Subject = "Our Company Invoice #" & varInvoiceNumber
mi.To = Forms!frmInvToEmail!BillingEmail
If IsNull(Forms!frmInvToEmail!BillingEmail2) = False Then
mi.CC = Forms!frmInvToEmail!BillingEmail2
Else
mi.CC = ""
End If
mi.Send
Set mi = Nothing
Set outl = Nothing


End Sub

[Welshgasman]

Make sure at least one character before the @ sign and the same after it?
Whilst there should be a domain name after, I do not think the mail programs are that clever.
Really should do this check in the form with the email address, not after when an email needs to be sent.

[Gicu]

Here is a function I use to validate the format of an email address:

 Public Function IsEMailAddress(ByVal sEmail As String, _
    Optional ByRef sReason As String) As Boolean
        
    Dim sPreffix As String
    Dim sSuffix As String
    Dim sMiddle As String
    Dim nCharacter As Integer
    Dim sBuffer As String


    sEmail = Trim(sEmail)


    If Len(sEmail) < 8 Then
        IsEMailAddress = False
        sReason = "Too short"
        Exit Function
    End If




    If InStr(sEmail, "@") = 0 Then
        IsEMailAddress = False
        sReason = "Missing the @"
        Exit Function
    End If




    If InStr(InStr(sEmail, "@") + 1, sEmail, "@") <> 0 Then
        IsEMailAddress = False
        sReason = "Too many @"
        Exit Function
    End If




    If InStr(sEmail, ".") = 0 Then
        IsEMailAddress = False
        sReason = "Missing the period"
        Exit Function
    End If


    If InStr(sEmail, "@") = 1 Or InStr(sEmail, "@") = Len(sEmail) Or _
        InStr(sEmail, ".") = 1 Or InStr(sEmail, ".") = Len(sEmail) Then
        IsEMailAddress = False
        sReason = "Invalid format"
    Exit Function


End If




For nCharacter = 1 To Len(sEmail)
    sBuffer = Mid$(sEmail, nCharacter, 1)
    If Not (LCase(sBuffer) Like "[a-z]" Or sBuffer = "@" Or _
    sBuffer = "." Or sBuffer = "-" Or sBuffer = "_" Or _
    IsNumeric(sBuffer)) Then: IsEMailAddress = _
    False: sReason = "Invalid character": Exit Function
Next nCharacter


nCharacter = 0


On Error Resume Next


sBuffer = Right(sEmail, 4)
If InStr(sBuffer, ".") = 0 Then GoTo TooLong:
If Left(sBuffer, 1) = "." Then sBuffer = Right(sBuffer, 3)
If Left(Right(sBuffer, 3), 1) = "." Then sBuffer = Right(sBuffer, 2)
If Left(Right(sBuffer, 2), 1) = "." Then sBuffer = Right(sBuffer, 1)




If Len(sBuffer) < 2 Then
    IsEMailAddress = False
    sReason = "Suffix too short"
    Exit Function
End If


TooLong:


If Len(sBuffer) > 3 Then
    IsEMailAddress = False
    sReason = "Suffix too long"
    Exit Function
End If


sReason = Empty
IsEMailAddress = True


End Function

Just add it to a standard module then use it in your code:

iF IsEMailAddress(Forms!frmInvToEmail!BillingEmail) Then mi.To = Forms!frmInvToEmail!BillingEmail

Cheers,

[cebrower]

Thanks, but the email addresses in question are properly formatted. They were just entered incorrectly (misspelled or a typo). It's an email address that should simply bounce but instead it throws an error. It's never happened until today and today it happed twice. Both emails were @aol.com if that means anything.

[Gicu]

You don't say which 'program" crashes so I assume is the Access app; it sounds like it is related to a delay in resolving the email address in the email client (Outlook), is Exchange involved at all? May want to try to use CDO emailing instead.

https://www.access-programmers.co.uk...resses.305766/

Cheers,