Per Blakey300:
In my DB, I have a students table that stores email addresses. I would like
to be able to send emails to all students rather then send individualy. Has
any one got any ideas on where to start with this.
When I did it, I iterated though my name/addr DB and qued an
email to each person, using canned subject/body text that I had
have stored elsewhere.
That process built an outgoing message que in Outlook. When i
was done, I opened up Outlook, eyeballed the message, and then
fired them off.
This might be wretched excess, but here's some VBA. I could
also zip up the app and send it to you if you're interested.
---------------------------------------------------------------
Function SendMessageToMailingList(ByVal theSubject As String,
ByVal theMessagePath As String, ByVal theToListPath As String) As
Boolean
1000 debugStackPush mModuleName & ": SendMessageToMailingList"
1001 On Error GoTo SendMessageToMailingList_err
' PURPOSE: To send the same message to many people
' ACCEPTS: - The message's Subject line
' - The message
' - DOS path of a list of recipients delimited only
by vbCrLf's
' RETURNS: True if successful, otherwise False
'
' NOTES: 1) There is no provision for CC. Each message
gets addressed with
' a single recipient in the "TO:" area.
1002 Dim myToArray() As String
Dim i As Integer
Dim myToCount As Integer
Dim myMapiError As Long
Dim okToProceed As Boolean
Dim myToListText As String
Dim myMessageText As String
1010 If Len(theSubject & "") = 0 Then
1011 bugAlert True, "Missing 'Subject' line."
1019 Else
1020 If Len(theMessagePath & "") = 0 Then
1021 bugAlert True, "Missing message text."
1029 Else
1030 If Len(theToListPath & "") = 0 Then
1031 bugAlert True, "Missing recipient list."
1039 Else
1050 If Not fileExist(theMessagePath) Then
1051 bugAlert True, "Unable to locate message file '"
& theMessagePath & "'."
1059 Else
1060 If Not fileExist(theToListPath) Then
1061 bugAlert True, "Unable to locate recipient
file '" & theToListPath & "'."
1069 Else
1080 okToProceed = True
1090 End If
1092 End If
1093 End If
1094 End If
1099 End If
1100 okToProceed = False
1110 myMessageText = getTextFromFile(theMessagePath, "")
1120 If Len(myMessageText) = 0 Then
1121 bugAlert True, "File '" & theMessagePath & "' is empty."
1122 Else
1130 myToListText = getTextFromFile(theToListPath,
mInternalDelimiter)
1131 If Len(myToListText) = 0 Then
1132 bugAlert True, "File '" & theToListPath & "' is empty."
1139 Else
1140 myToCount = countTokens(myToListText,
mInternalDelimiter)
1141 If myToCount < 1 Then
1142 bugAlert True, "'To:' list has zero recipients. This
should not be possible."
1149 Else
1150 If myToCount < 2 Then
1151 bugAlert True, "'To:' list must have more than
one recipient. If you think it does, check the list's delimiter
against the delimiter supplied to this routine."
1159 Else
1160 ReDim myToArray(0 To myToCount)
1161 parseToArray myToListText, mInternalDelimiter,
myToArray()
1162 okToProceed = True
1190 End If
1191 End If
1192 End If
1199 End If
1500 If okToProceed = True Then
1530 For i = 0 To myToCount - 1
1540 okToProceed = SendOneMessage(theSubject,
Trim$(myToArray(i)), "", "", myMessageText, myMapiError)
1541 If okToProceed = False Then
1542 bugAlert True, "SendOneMessage failed with MAPI
error " & Str(myMapiError)
1543 Exit For
1549 End If
1550 Next i
1570 SendMessageToMailingList = okToProceed
1599 End If
SendMessageToMailingList_xit:
debugStackPop
On Error Resume Next
Exit Function
SendMessageToMailingList_err:
bugAlert True, ""
Resume SendMessageToMailingList_xit
End Function
