F
FA
Hi freinds i have the following code that send the email to all
contacts in the Query. Sometimes the email address is curupted or bad,
and Outlook would not send the email, is there anyway to create a log
for those bad or currputed email address for Contacts from the query. I
am trying to automate this code so it will run automatically in a
timely manner. If the email address is bad or currupted, i dont know
wheter the outlook would stop sending email to the rest of the results
in query or if it will skip the one that are bad, and if thats the case
how would i find out that the email was not been sent to those contact
where email address were bad or currupted. That's why i need to have a
log where it will store all the bad email address. Is there any way i
can have some codes added to the codes below to create this kind of
functionality?
Dim strTo As String
Dim strSubject As String
Dim varMsg As Variant
Dim varAttachment As Variant
Dim strFlagSQL As String
'Set reference to Outlook
On Error GoTo Errhandler
Dim strBCC As String
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim objOutl As Outlook.Application
'Dim objEml As Outlook.MailItem
Dim I As Integer
Set db = CurrentDb
Set rst = CurrentDb().OpenRecordset("qryContactsForFullATAR",
dbOpenSnapshot, dbSeeChanges)
Set objOutl = CreateObject("Outlook.application")
'Set objEml = objOutl.createItem(olMailitem)
With rst
If .RecordCount > 0 Then
.MoveLast
.MoveFirst
End If
End With
For I = 1 To rst.RecordCount
If Len(rst!PRA_CTAC_NME) > 0 Then
strTo = rst!PRA_CTAC_NME
strSubject = rst!SYS_NME & " " & " " & "PRA Results"
varMsg = emailBody
Dim objEml As Outlook.MailItem
Set objEml = objOutl.CreateItem(olMailItem)
With objEml
.To = strTo
.Subject = strSubject
If Not IsNull(varMsg) Then
.Body = varMsg
End If
' Uncomment for attachment
' If Not IsMissing(varAttachment) Then
' .Attachments.Add varAttachment
' End If
.Send
strFlagSQL = "UPDATE dbo_SYS_INFO SET
dbo_SYS_INFO.TEST_STAT_ID = 8 WHERE dbo_SYS_INFO.SYS_ID_CODE =" _
& rst.Fields("SYS_ID_CODE").Value & ";"
db.Execute strFlagSQL, dbFailOnError Or dbSeeChanges
'Set rst = CurrentDb().OpenRecordset(strFlagSQL,
dbOpenSnapshot, dbSeeChanges)
End With
End If
Set objEml = Nothing
rst.MoveNext
Next I
ExitHere:
Set objOutl = Nothing
'Set objEml = Nothing
Set rst = Nothing
Set db = Nothing
Exit Sub
Errhandler:
MsgBox Err.Number & ": " & Err.Description
Resume ExitHere
contacts in the Query. Sometimes the email address is curupted or bad,
and Outlook would not send the email, is there anyway to create a log
for those bad or currputed email address for Contacts from the query. I
am trying to automate this code so it will run automatically in a
timely manner. If the email address is bad or currupted, i dont know
wheter the outlook would stop sending email to the rest of the results
in query or if it will skip the one that are bad, and if thats the case
how would i find out that the email was not been sent to those contact
where email address were bad or currupted. That's why i need to have a
log where it will store all the bad email address. Is there any way i
can have some codes added to the codes below to create this kind of
functionality?
Dim strTo As String
Dim strSubject As String
Dim varMsg As Variant
Dim varAttachment As Variant
Dim strFlagSQL As String
'Set reference to Outlook
On Error GoTo Errhandler
Dim strBCC As String
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim objOutl As Outlook.Application
'Dim objEml As Outlook.MailItem
Dim I As Integer
Set db = CurrentDb
Set rst = CurrentDb().OpenRecordset("qryContactsForFullATAR",
dbOpenSnapshot, dbSeeChanges)
Set objOutl = CreateObject("Outlook.application")
'Set objEml = objOutl.createItem(olMailitem)
With rst
If .RecordCount > 0 Then
.MoveLast
.MoveFirst
End If
End With
For I = 1 To rst.RecordCount
If Len(rst!PRA_CTAC_NME) > 0 Then
strTo = rst!PRA_CTAC_NME
strSubject = rst!SYS_NME & " " & " " & "PRA Results"
varMsg = emailBody
Dim objEml As Outlook.MailItem
Set objEml = objOutl.CreateItem(olMailItem)
With objEml
.To = strTo
.Subject = strSubject
If Not IsNull(varMsg) Then
.Body = varMsg
End If
' Uncomment for attachment
' If Not IsMissing(varAttachment) Then
' .Attachments.Add varAttachment
' End If
.Send
strFlagSQL = "UPDATE dbo_SYS_INFO SET
dbo_SYS_INFO.TEST_STAT_ID = 8 WHERE dbo_SYS_INFO.SYS_ID_CODE =" _
& rst.Fields("SYS_ID_CODE").Value & ";"
db.Execute strFlagSQL, dbFailOnError Or dbSeeChanges
'Set rst = CurrentDb().OpenRecordset(strFlagSQL,
dbOpenSnapshot, dbSeeChanges)
End With
End If
Set objEml = Nothing
rst.MoveNext
Next I
ExitHere:
Set objOutl = Nothing
'Set objEml = Nothing
Set rst = Nothing
Set db = Nothing
Exit Sub
Errhandler:
MsgBox Err.Number & ": " & Err.Description
Resume ExitHere