B
Blakey300
Hi all
I have the code below running on my access 2007 db
This code creates a text string of student email address then cpies the
string to the bcc box of outlook and i works great, however I wish to improve
this slightly, as there are ocassions where mutiple students have the same
registared email address (ie:junior students have parents addresses).
My question is as follows:-
can I tweak this code so that it will ignore duplicate addresses thus
aviding sending duplicate emails to the same address?
Please do not surgest that i use mail merge from word which is the standard
response that is normally given, as this is not a viable option as i intend
to hand the general running of the db over to the instructor, who has limited
pc knowledge.
Regards
Dave
Code:-
Option Compare Database
Option Explicit
Function TorquayBulkEmail() As String
On Error GoTo ProcError
'Purpose: Return a string containing all the email addresses to mail to.
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strOut As String
Dim lngLen As Long
Const conSEP = ";"
strSQL = "SELECT [E-MailAddress] FROM [Students] " _
& "WHERE (([E-MailAddress] Is Not Null)And ([Active]=YES) and
([HomeClub]=1)And ([EmailUpdates]=YES));"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
With rs
Do While Not .EOF
strOut = strOut & ![E-mailAddress] & conSEP
.MoveNext
Loop
End With
lngLen = Len(strOut) - Len(conSEP)
If lngLen > 0 Then
TorquayBulkEmail = Left$(strOut, lngLen)
End If
'Debug.Print BulkEmail '(<--uncomment line to see results in Immed. Window).
ExitProc:
If Not rs Is Nothing = True Then
rs.Close: Set rs = Nothing
End If
Set db = Nothing
Exit Function
ProcError:
MsgBox Err.Number & ": " & Err.Description, _
vbCritical, "Error in TorquayBulkEmail function..."
Resume ExitProc
End Function
Function TorquaySendEmail()
On Error GoTo ProcError
DoCmd.SendObject _
To:=DLookup("[E-mailAddress]", "Chief Instructor Details"), _
BCC:=TorquayBulkEmail, _
Subject:="", _
MessageText:="", _
EditMessage:=True
ExitProc:
Exit Function
ProcError:
Select Case Err.Number
'User cancelled message (2293 & 2296 are raised by Outlook, not Outlook
Express).
Case 2501, 2293, 2296
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure TorquaySendEMail..."
End Select
Resume ExitProc
End Function
I have the code below running on my access 2007 db
This code creates a text string of student email address then cpies the
string to the bcc box of outlook and i works great, however I wish to improve
this slightly, as there are ocassions where mutiple students have the same
registared email address (ie:junior students have parents addresses).
My question is as follows:-
can I tweak this code so that it will ignore duplicate addresses thus
aviding sending duplicate emails to the same address?
Please do not surgest that i use mail merge from word which is the standard
response that is normally given, as this is not a viable option as i intend
to hand the general running of the db over to the instructor, who has limited
pc knowledge.
Regards
Dave
Code:-
Option Compare Database
Option Explicit
Function TorquayBulkEmail() As String
On Error GoTo ProcError
'Purpose: Return a string containing all the email addresses to mail to.
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strOut As String
Dim lngLen As Long
Const conSEP = ";"
strSQL = "SELECT [E-MailAddress] FROM [Students] " _
& "WHERE (([E-MailAddress] Is Not Null)And ([Active]=YES) and
([HomeClub]=1)And ([EmailUpdates]=YES));"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
With rs
Do While Not .EOF
strOut = strOut & ![E-mailAddress] & conSEP
.MoveNext
Loop
End With
lngLen = Len(strOut) - Len(conSEP)
If lngLen > 0 Then
TorquayBulkEmail = Left$(strOut, lngLen)
End If
'Debug.Print BulkEmail '(<--uncomment line to see results in Immed. Window).
ExitProc:
If Not rs Is Nothing = True Then
rs.Close: Set rs = Nothing
End If
Set db = Nothing
Exit Function
ProcError:
MsgBox Err.Number & ": " & Err.Description, _
vbCritical, "Error in TorquayBulkEmail function..."
Resume ExitProc
End Function
Function TorquaySendEmail()
On Error GoTo ProcError
DoCmd.SendObject _
To:=DLookup("[E-mailAddress]", "Chief Instructor Details"), _
BCC:=TorquayBulkEmail, _
Subject:="", _
MessageText:="", _
EditMessage:=True
ExitProc:
Exit Function
ProcError:
Select Case Err.Number
'User cancelled message (2293 & 2296 are raised by Outlook, not Outlook
Express).
Case 2501, 2293, 2296
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure TorquaySendEMail..."
End Select
Resume ExitProc
End Function