I have written a specialized email application In ACCESS 2010 for my department. At first I couldn't send email outside our domain so the server folks turned on relay and gave me a static IP address. However, now the mail server does not reject bad email addresses unless I leave off everything to the right of the @ sign. Example my sort of address is me@mycompany.org. But if I change something in the address, such as mexxxx@mycompany.org I don't get an error message back from the mail server, error handling is ignored and it counts as being sent. This is true for emails going both inside and outside the domain. It seems to me that something needs to be configured on the host, or I need to do something in my ap. (I'm really no expert here.) The Send part of the code is an ACCESS 2010 function. (Mail server is MSExchange 2010.) If nothing is wrong it works great.
Public Sub SendAMessage(strFrom As String, strTo As String, _
strSubject As String, strTextBody As String, _
Optional strAttachDoc As String, Optional strCC As String, _
Optional strBcc As String)
On Error GoTo ErrorHandler
Set objMessage = New CDO.Message
With objMessage
.From = strFrom
.To = strTo
Debug.Print strTo
If Len(Trim$(strCC)) > 0 Then
.CC = strCC
End If
If Len(strBcc) > 0 Then
.BCC = strBcc
End If
.Subject = strSubject
.TextBody = strTextBody
If Len(strAttachDoc) > 0 Then
.AddAttachment strAttachDoc
End If
With .Configuration.Fields
.Item(CDO.cdoSMTPServer) = "mymail"
.Item(CDO.cdoSMTPServerPort) = xx
.Item(CDO.cdoSendUsingMethod) = CDO.cdoSendUsingPort
.Item(cdoSMTPConnectionTimeout) = xx
.Update
End With
.Send
End With
Set objMessage = Nothing
Dim CurDateTime As DependencyInfo
CDateTime = Now()
Dim AccountNo As String
AccountNo = GBL_Master_Id
If GBL_PostMailSwitch = True Then 'Test if in management and skip the next three statements
Dim SentSql As String
'DoCmd.SetWarnings False
'SentSql = "INSERT INTO SentEmailTbl(Account_Number, Event, DateSent) Values('" & GBL_Master_Id & "', '" & GBL_Event & "', # " & Now() & " #)"
'DoCmd.RunSQL SentSql
'DoCmd.SetWarnings True
End If
Exit Sub
ErrorHandler:
Dim BadEmSql As String
Dim emVal As String
'MsgBox "in error Handler" & " " & Err.Number
'If Err.Number = -2147220977 Or -2147220980 Then
'MsgBox "Bad email"
DoCmd.SetWarnings False
BadEmSql = "INSERT INTO EmErrorsTbl(AccountNo, EmailAddress, ErrNo, ErrMsg, ErrDate) VALUES('" & GBL_Master_Id & "', '" & strTo & "', '" & Err.Number & "', '" & Err.Description & "','" & GBL_DateSent & "')"
GBL_Rejected = GBL_Rejected + 1
Forms!EmailForm!emRejected = GBL_Rejected
DoCmd.RunSQL BadEmSql
DoCmd.SetWarnings True
'End If
Resume Next
End Sub
Public Sub SendAMessage(strFrom As String, strTo As String, _
strSubject As String, strTextBody As String, _
Optional strAttachDoc As String, Optional strCC As String, _
Optional strBcc As String)
On Error GoTo ErrorHandler
Set objMessage = New CDO.Message
With objMessage
.From = strFrom
.To = strTo
Debug.Print strTo
If Len(Trim$(strCC)) > 0 Then
.CC = strCC
End If
If Len(strBcc) > 0 Then
.BCC = strBcc
End If
.Subject = strSubject
.TextBody = strTextBody
If Len(strAttachDoc) > 0 Then
.AddAttachment strAttachDoc
End If
With .Configuration.Fields
.Item(CDO.cdoSMTPServer) = "mymail"
.Item(CDO.cdoSMTPServerPort) = xx
.Item(CDO.cdoSendUsingMethod) = CDO.cdoSendUsingPort
.Item(cdoSMTPConnectionTimeout) = xx
.Update
End With
.Send
End With
Set objMessage = Nothing
Dim CurDateTime As DependencyInfo
CDateTime = Now()
Dim AccountNo As String
AccountNo = GBL_Master_Id
If GBL_PostMailSwitch = True Then 'Test if in management and skip the next three statements
Dim SentSql As String
'DoCmd.SetWarnings False
'SentSql = "INSERT INTO SentEmailTbl(Account_Number, Event, DateSent) Values('" & GBL_Master_Id & "', '" & GBL_Event & "', # " & Now() & " #)"
'DoCmd.RunSQL SentSql
'DoCmd.SetWarnings True
End If
Exit Sub
ErrorHandler:
Dim BadEmSql As String
Dim emVal As String
'MsgBox "in error Handler" & " " & Err.Number
'If Err.Number = -2147220977 Or -2147220980 Then
'MsgBox "Bad email"
DoCmd.SetWarnings False
BadEmSql = "INSERT INTO EmErrorsTbl(AccountNo, EmailAddress, ErrNo, ErrMsg, ErrDate) VALUES('" & GBL_Master_Id & "', '" & strTo & "', '" & Err.Number & "', '" & Err.Description & "','" & GBL_DateSent & "')"
GBL_Rejected = GBL_Rejected + 1
Forms!EmailForm!emRejected = GBL_Rejected
DoCmd.RunSQL BadEmSql
DoCmd.SetWarnings True
'End If
Resume Next
End Sub