Hi everyone,
Hope you can help me. I have a database that sends emails trough outlook, the code works fine, however when the outlook does not recognize the email (because there is no person with that email in the organization that I am in) the macro stops and I have to start all over again. (Previous emails are sent, but the ones after the email that is not recognized are not).
Is there any way to indicate to the code that if this happens avoid the error and continue with the loop?
Here is my code:
Hope you can help me. I have a database that sends emails trough outlook, the code works fine, however when the outlook does not recognize the email (because there is no person with that email in the organization that I am in) the macro stops and I have to start all over again. (Previous emails are sent, but the ones after the email that is not recognized are not).
Is there any way to indicate to the code that if this happens avoid the error and continue with the loop?
Here is my code:
Code:
Private Sub Command133_Click()
Dim MyDB As Database
Dim MyRS As Recordset
Dim MyForm As Form
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim TheAddress As String
Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset("Comunicacion 2")
MyRS.MoveFirst
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
Do Until MyRS.EOF
' Create the e-mail message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
TheAddress = MyRS![Enterprise]
With objOutlookMsg
' Add the To recipients to the e-mail message.
Set objOutlookRecip = .Recipients.Add(TheAddress)
objOutlookRecip.Type = olBCC
' Set the Subject, the Body, and the Importance of the e-mail message.
.To = MyRS![Enterprise]
.Subject = " URGENT ACTION REQUIRED - US Immigration Information Requestt"
.HTMLBody = "<html><body><font face=calibri> Testing</font></body></html>"
.Importance = olImportanceHigh 'High importance
' Resolve the name of each Recipient.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send
End With
MyRS.MoveNext
Loop
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub