We are using the code to send an email and for some reason it fails to send the email. The search critreia on our search form works great but when it comes to this email function it fails. I was told it might be due to the value “NULL” of the “exempt site” blocking the program from sending emails. It’s built in the program logic, it should be 0 in order to send out any emails. I have a temporary solution, just remove the “exempt site” condition clause from the VB program. Not sure how to remove the exempt site from the code without breaking the whole thing. Is there a way to modify this code to process sites in a exempt state or how can I just rem this out from the VB code to allow the email to process? really at a lose here. Thanks for the help…
[codebox]Private Sub Send_Email_Click()
On Error GoTo Err_Send_Email_Click
Call Process_Email
Exit_Send_Email_Click:
Exit Sub
Err_Send_Email_Click:
MsgBox Err.Description
Resume Exit_Send_Email_Click
End Sub
Function Process_Email()
Dim i As Integer ‘– End of file
Dim temp_userid As String
Dim intSendFlag As Integer
Dim strEmailName As String
Dim strPrevSite As String
Dim intfirst As Integer
intSendFlag = 0
intfirst = 0
i = 0
strPrevSite = “”
DoCmd.SetWarnings False
temp_userid = Environ(“username”)
DoCmd.GoToRecord acDataForm, Me.Name, acFirst
Do While i < Me.Recordset.RecordCount
MsgBox "original state: " & Me.site_cp_readiness_status & Me.Send_No & "CP" & Me.ExemptCP & Me.Site_ID
If Not Me.NewRecord Then
MsgBox "Not New record: " & Me.site_cp_readiness_status & Me.Send_No & Me.ExemptCP & Me.Site_ID
If Me.site_cp_readiness_status “Y” And Me.Send_No = 0 And Me.ExemptCP = 0 Then
MsgBox “Prepare email ” & Me.site_cp_readiness_status & Me.Send_No & Me.ExemptCP & Me.Site_ID
If strPrevSite Me.Site_ID Or intfirst = 0 Then
Call Send_Emailobject(strEmailName)
MsgBox “email sent ” & i & strEmailName
strPrevSite = Me.Site_ID
intfirst = 1
End If
Call Insert_Datarecon_EmailStatus(strEmailName)
ElseIf Me.Send_No = -1 Then
intSendFlag = 1
End If ‘Send_No = 0
i = i + 1
MsgBox “process record ” & i
If i = 3 Then
Exit Do
End If
Else: Exit Do
End If ‘Not Me.NewRecord
If i < Me.Recordset.RecordCount Then
DoCmd.GoToRecord acDataForm, Me.Name, acNext
End If
Loop
If intSendFlag = 1 Then
Call Update_Sendflag ' update send_no = 0
End If
Exit Function
End Function
Public Function Send_Emailobject(strEmailName)
On Error GoTo ErrHandler
Dim db As Database
Dim rs As Recordset
Dim strSubject As String
Dim srt As String
Dim strDoc As String
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim blnStart As Boolean
gstrRptSite = Me.Site_ID
If Left(Me.Site_ID, 4) = "STN8" Then
srt = "jim@aol.com"
ElseIf IsNull(Me.Email1) Or Me.Email1 < " " Then
srt = "governance@iii.org"
Else
srt = Me.Email1
End If
' srt = Environ("username") & "@iii.com" ' for testing
' Determine the type of email to send
If Me.site_cp_readiness_status = "P" Then
If Me.Disconnect = -1 Then
strEmailName = "Preloading CP – Stuck Mode 2"
Else
strEmailName = "Preloading CP – Stuck"
End If
Else
If Me.Disconnect = -1 Then
strEmailName = "loading CP"
Else
strEmailName = "Pre loading CP"
End If
End If
strDoc = "F:Responses" & strEmailName & ".doc"
strSubject = Me.Site_ID & ", " & Me.Country & ", " & Me.Region & " Reminder: Preloading Your CP"
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
If objWord Is Nothing Then
Set objWord = CreateObject("Word.Application")
If objWord Is Nothing Then
MsgBox "Cannot start Word.", vbExclamation
Exit Function
End If
blnStart = True
End If
Set objDoc = objWord.Documents.Open(strDoc)
With objDoc.MailEnvelope.Item
.To = Nz(srt, "")
.Subject = strSubject
.SentOnBehalfOfName = "governance@iii.com"
.Send
End With
GoTo ExitHandler
ExitHandler:
On Error Resume Next
objDoc.Close SaveChanges:=False
Set objDoc = Nothing
If blnStart Then
objWord.Quit
End If
Set objWord = Nothing
Exit Function
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End Sub[/codebox]
