array for email recipients

[n8kindt]

i have a function created for simple emailing (posted below). i'm new to arrays. i actually figured out how to set up the last value (Att) as an array so i could add an unlimited amount of attachments. now, i'm wondering how i could do the same for the MsgTo variable so i can add an unlimited amount of recipients. will i have to create a separate array function that will be used in the MsgTo value slot? here's my code:

Option Compare Database
Function EmailMsgTo(MsgTo As String, MsgFrom As String, MsgSubject As String, _
MsgBodyHTMLSite As String, MsgBodyHTMLfile As String, MsgBodyText As String, _
ParamArray Att() As Variant)
 
 
Const cdoSendUsingPickup = 1
Const cdoSendUsingPort = 2 'Must use this to use Delivery Notification
Const cdoAnonymous = 0
Const cdoBasic = 1 ' clear text
Const cdoNTLM = 2 'NTLM
'Delivery Status Notifications
Const cdoDSNDefault = 0 'None
Const cdoDSNNever = 1 'None
Const cdoDSNFailure = 2 'Failure
Const cdoDSNSuccess = 4 'Success
Const cdoDSNDelay = 8 'Delay
Const cdoDSNSuccessFailOrDelay = 14 'Success, failure or delay
Dim i As Integer
 
Set objmsg = CreateObject("CDO.Message")
Set objConf = CreateObject("CDO.Configuration")
 
Set objFlds = objConf.Fields
With objFlds
  .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
  'Name or IP of Remote SMTP Server
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "******************"
  'Type of authentication, NONE, Basic (Base64 encoded), NTLM
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
  'Your UserID on the SMTP server
  .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "***************@*********"
  'Your password on the SMTP server
  .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "********************"
  'Server port (typically 25)
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
  'Use SSL for the connection (False or True)
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
  'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
  .Update
End With
 
 
 
 
 
With objmsg
  Set .Configuration = objConf
  .To = MsgTo
  .From = MsgFrom
  .Subject = MsgSubject
 
  If MsgBodyHTMLSite <> "" Then
  .CreateMHTMLBody MsgBodyHTMLSite
  GoTo SendMsg
  End If
 
  If MsgBodyHTMLfile <> "" Then
  .htmlBody = MsgBodyHTMLfile
  GoTo SendMsg
  End If
 
  If MsgBodyText <> "" Then
  .TextBody = MsgBodyText
  GoTo SendMsg
  End If
 
 
 
 
SendMsg:
      For i = LBound(Att) To UBound(Att)
        objmsg.addattachment Att(i)
      Next i
 
  .Fields("urn:schemas:mailheader:disposition-notification-to") = MsgFrom
  .Fields("urn:schemas:mailheader:return-receipt-to") = MsgFrom
  .DSNOptions = cdoDSNSuccessFailOrDelay
  .Fields.Update
  .Send
End With
End Function

[Dököll]

Hello, n8kindt!

I don't like arrays either, but do stay tuned for a better answer, I am not telling you what you need here.

Are you trying to set up a mass email program? You could probably figure out code to simply add separators after each email address rather than an array of fields, if you're interested; just a shortcut since I absolutely dislike arrays:-)

Good luck!

Dököll

[n8kindt]

Hello, n8kindt!

I don't like arrays either, but do stay tuned for a better answer, I am not telling you what you need here.

Are you trying to set up a mass email program? You could probably figure out code to simply add separators after each email address rather than an array of fields, if you're interested; just a shortcut since I absolutely dislike arrays:-)

Good luck!

Dököll

thanks for your reply! it's not really a mass email program per se. i suppose you could call it that. but yeah i would be interested in that code! how would i go about doing that?

i have actually already set up a program that emails personal reports before. but that uses a loop and only does one email at a time. now i'm just trying to set up a simple email program that allows users to send messages to multiple recipients (just like you would if u were in gmail, yahoo, etc, etc where u check each recipient and it jams all those addresses in the "to" field) all at once instead of one at a time.

i actually haven't figured out an efficient way of selecting the recipients either. but i'm working on it.

[ADezii]

I'm not exactly sure that I fully understand your request, but perhaps you can use a common Delimiter between Recipients, use the Split() Function to populate a Variant Array with the items, then it would be an easy matter to iterate through them, as in:

Dim strRecipients As String
Dim varRecipients As Variant
Dim intCounter As Integer
 
strRecipients = "Tom;Fred;Gil;Jane;Holly;Matt"
 
varRecipients = Split(strRecipients, ";")
 
For intCounter = LBound(varRecipients) To UBound(varRecipients)
  Debug.Print varRecipients(intCounter)
Next

OUTPUT:

Tom
Fred
Gil
Jane
Holly
Matt

Is this what you are looking for?

[n8kindt]

I'm not exactly sure that I fully understand your request, but perhaps you can use a common Delimiter between Recipients, use the Split() Function to populate a Variant Array with the items, then it would be an easy matter to iterate through them, as in:

Dim strRecipients As String
Dim varRecipients As Variant
Dim intCounter As Integer
 
strRecipients = "Tom;Fred;Gil;Jane;Holly;Matt"
 
varRecipients = Split(strRecipients, ";")
 
For intCounter = LBound(varRecipients) To UBound(varRecipients)
  Debug.Print varRecipients(intCounter)
Next

OUTPUT:

Tom
Fred
Gil
Jane
Holly
Matt

Is this what you are looking for?

ok, at first i didn't see what u were getting at but now i do. hmmm this is probably the best idea thus far. and it should do the trick.

now i get to work on figuring out how to add recipients thru interface. i'd like to use a checkbox interface (if the recipients are checked and then the ok button pressed, they are jammed into this array) like most web email programs use but i'm open to anything at this point. if anyone has any bright ideas, i would appreciate it if they shared their knowledge..

and thanks, ADezii! very much appreciated your reply!

[ADezii]

ok, at first i didn't see what u were getting at but now i do. hmmm this is probably the best idea thus far. and it should do the trick.

now i get to work on figuring out how to add recipients thru interface. i'd like to use a checkbox interface (if the recipients are checked and then the ok button pressed, they are jammed into this array) like most web email programs use but i'm open to anything at this point. if anyone has any bright ideas, i would appreciate it if they shared their knowledge..

and thanks, ADezii! very much appreciated your reply!

Let's assume you have a Data Source with a [Recipient] (Yes/No Field) and a [Name] Field, and that this Data Source is named tblTest. The following code will store into an Array the Names of all Recipients ([Recipient] = Yes/True and Name Not Null). It would then be a simple matter to retrieve them. Any questions, feel free to ask.

Dim MyDB As DAO.Database
Dim MyRS As DAO.Recordset
Dim intNumOfRecipients As Integer
Dim intIndex As Integer
Dim intCounter As Integer
 
intArrayIndex = 1       'initialize
 
'# of Recipients ([Recipient] = Yes/True
intNumOfRecipients = DCount("*", "tblTest", "[Recipient] = True")
 
Set MyDB = CurrentDb()
Set MyRS = MyDB.OpenRecordset("tblTest", dbOpenForwardOnly)
 
If intNumOfRecipients > 0 Then      'need at least 1 Recipient
 ReDim astrRecipients(1 To intNumOfRecipients) As String
  With MyRS
    Do While Not .EOF
      'If [Recipient] is checked and a valid Name
      If ![Recipient] And Not IsNull(![Name]) Then
        astrRecipients(intArrayIndex) = ![Name]     'add to Array
        intArrayIndex = intArrayIndex + 1           'increment Index
      End If
      .MoveNext
    Loop
End With
End If
 
MyRS.Close
Set MyRS = Nothing
 
'Playback time
If intNumOfRecipients > 0 Then      'need at least 1 Recipient
  For intCounter = LBound(astrRecipients) To UBound(astrRecipients)
    Debug.Print astrRecipients(intCounter)
  Next
End If

OUTPUT:

Helen
Regina
Peggy
Vince
Joe
Tom
Mary

[n8kindt]

Let's assume you have a Data Source with a [Recipient] (Yes/No Field) and a [Name] Field, and that this Data Source is named tblTest. The following code will store into an Array the Names of all Recipients ([Recipient] = Yes/True and Name Not Null). It would then be a simple matter to retrieve them. Any questions, feel free to ask.

Dim MyDB As DAO.Database
Dim MyRS As DAO.Recordset
Dim intNumOfRecipients As Integer
Dim intIndex As Integer
Dim intCounter As Integer
 
intArrayIndex = 1       'initialize
 
'# of Recipients ([Recipient] = Yes/True
intNumOfRecipients = DCount("*", "tblTest", "[Recipient] = True")
 
Set MyDB = CurrentDb()
Set MyRS = MyDB.OpenRecordset("tblTest", dbOpenForwardOnly)
 
If intNumOfRecipients > 0 Then      'need at least 1 Recipient
 ReDim astrRecipients(1 To intNumOfRecipients) As String
  With MyRS
    Do While Not .EOF
      'If [Recipient] is checked and a valid Name
      If ![Recipient] And Not IsNull(![Name]) Then
        astrRecipients(intArrayIndex) = ![Name]     'add to Array
        intArrayIndex = intArrayIndex + 1           'increment Index
      End If
      .MoveNext
    Loop
End With
End If
 
MyRS.Close
Set MyRS = Nothing
 
'Playback time
If intNumOfRecipients > 0 Then      'need at least 1 Recipient
  For intCounter = LBound(astrRecipients) To UBound(astrRecipients)
    Debug.Print astrRecipients(intCounter)
  Next
End If

OUTPUT:

Helen
Regina
Peggy
Vince
Joe
Tom
Mary

wow, i am so glad you saved me the headache of trying to set up that array! i think i've learned more about arrays from this code than i have researching them the last two days! thank you so much. i think i can take care of the rest myself from here.

cheers,
nate

[ADezii]

wow, i am so glad you saved me the headache of trying to set up that array! i think i've learned more about arrays from this code than i have researching them the last two days! thank you so much. i think i can take care of the rest myself from here.

cheers,
nate

You are quite welcome Nate, good luck and keep in touch,

[n8kindt]

You are quite welcome Nate, good luck and keep in touch,

turns out, that i didn't actually need an array to add multiple recipients. the .to is populated by a giant string that separates the email recipients by using delimiter ";" AFTER it is sent thru my code... i still needed an array to pile all the recipients into one string though. here we go...

i have a email form that can be populated by clicking on managers, supervisors, or all buttons. i'll use managers for this demo. the manager click event opens the manager list whose load form event goes like this:

Private Sub Form_Load()
 
    Set DB = CurrentDb
    Set qdf = DB.QueryDefs("qryEmailListManagers")
    Set RS = qdf.OpenRecordset()
With RS
If Not .EOF Then
.MoveFirst
Do
.Edit
.Fields!CheckBox = True
.Update
.MoveNext
Loop Until .EOF
End If
.Close
End With
DB.Close
Set RS = Nothing
Set DB = Nothing
qdf.Close
Set qdf = Nothing
 
 
End Sub

once the user picks the appropriate records, they click the ok button and the onclick fires this event and throws the string into the to field:

Private Sub Command2_Click()
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim intNumOfRecipients As Integer
Dim intIndex As Integer
Dim intCounter As Integer
Dim FName As String
Dim FQName As String
Dim EmailA As String
Dim strMsgTo As String
Dim strTo As String
 
intArrayIndex = 1       'initialize
 
'# of Recipients ([Recipient] = Yes/True
intNumOfRecipients = DCount("*", "QryEmailListManagers", "[CheckBox] = True")
strTo = ""
 
 
Set DB = CurrentDb
Set qdf = DB.QueryDefs("qryEmailListManagers")
Set RS = qdf.OpenRecordset()
 
 
If intNumOfRecipients > 0 Then      'need at least 1 Recipient
 ReDim astrRecipients(1 To intNumOfRecipients) As String
  With RS
    Do While Not .EOF
      'If [Recipient] is checked and a valid Name
      If ![CheckBox] = True And Not IsNull(![email]) Then
        FName = ![First Name]
        FQName = """" & FName & """"
        EmailA = !Email
        strMsgTo = FQName & " <" & EmailA & ">" & "; "
 
        strTo = strTo & strMsgTo
      End If
      .MoveNext
    Loop
End With
End If
 
RS.Close
Set MyRS = Nothing
 
Forms!frmEmailForm.txtTo.Value = strTo
Debug.Print strTo
If intNumOfRecipients > 0 Then      'need at least 1 Recipient
  For intCounter = LBound(astrRecipients) To UBound(astrRecipients)
    Debug.Print astrRecipients(intCounter)
  Next
End If
 

and that is pretty much it. it wasn't easy as it looks for me b/c i have some tricky variables to work around that were particular only to my situation. i have a email function (posted above) that grabs all the info from the form and emails it out. right now, my next task is to create a way for a user to select their attachment file by clicking on the "browse" button. right now you have to copy and paste the entire file name. any ideas? i'm also going to post another thread for that specific topic

props again to ADezii... i would have cracked my head in two trying to figure out how to do that array without him since i didn't have any real background in them before.