Using an array to speciy email recipients (Access 2007 - Lotus Notes) (1 Viewer)

CazB

Registered User.
Local time
Today, 09:38
Joined
Jul 17, 2013
Messages
309
I've got a form which emails out a report when a new record is added to my database but I'm stuck when it comes to making it send it to more than one recipient.


I came across this on the web... which suggests I should be using an array but I don't know anything about arrays so I'm bamboozled!

for multiple email addresses you just set MailDoc.sendto to an array of variants each of which will receive the message. So
Code:
Dim recip(25) as variant
recip(0) = "emailaddress1"
recip(1) = "emailaddress2" e.t.c

maildoc.sendto = recip


My problem is I'm not sure how to implement it?
My 'recipients' are being pulled from a query... how do I get that into the array of variants?

If you need to see all the code, please let me know and I'll post it up!
 

CazB

Registered User.
Local time
Today, 09:38
Joined
Jul 17, 2013
Messages
309
ok, I have the string of recipient email addresses - how do I tell it to send it to them all?

If I just pass the string through into my 'sendto', it only goes to the first one on the list.... but I need it to go to them all and I don't know how to do that...? Where does the Array come in and how do I use it?
 

pr2-eugin

Super Moderator
Local time
Today, 09:38
Joined
Nov 30, 2011
Messages
8,494
Caz, I am not sure if you are following the method I proposed.. There is no array involved in my option.. The code you should be having is..
Code:
Public Function getEmail(qryName As String) As String
    Dim dbObj As DAO.Database, rstObj As DAO.Recordset
    Dim emailStr As String
    
    Set dbObj = CurrentDb
    Set rstObj = dbObj.OpenRecordset(qryName)
    
    Do While Not rstObj.EOF
        emailStr = emailStr & rstObj.Fields(0) & ";"
        rstObj.MoveNext
    Loop
    
    If Len(emailStr) > 0 Then
        getEmail = Left(emailStr, Len(emaistr) - 1)
    Else
        getEmail = vbNullString
    End If
End Function
I am not sure how you are sending the email.. I assume you are using Outlook application.. So in the To property you will use..
Code:
With outLookObj
    .To = getEmail("emailQueryName")
    .Subject = "Something
[COLOR=SeaGreen]'rest of code[/COLOR]
The Query can be be built in or also could be..
Code:
With outLookObj
    .To = getEmail("SELECT emailFieldName FROM theTableName;")
    .Subject = "Something
[COLOR=SeaGreen]'rest of code[/COLOR]
 
Last edited:

CazB

Registered User.
Local time
Today, 09:38
Joined
Jul 17, 2013
Messages
309
This is the function I use to send the Lotus Notes email:

Code:
Function MailLotusApp(strRecipient As String, strSubject As String, strBodyText As String, strExtraText As String)
'This function sends the mail
 
'Setup the objects required for Automation into Lotus notes
 Dim Maildb As Object ' The mail database
 Dim UserName As String 'The users notes name
 Dim MailDbName As String ' The users notes mail database name
 Dim MailDoc As Object ' The mail doc itself
 Dim Session As Object ' The notes session
 Dim AttachME As Object 'The attachment richtextfile object
 Dim EmbedObj As Object 'The embedded object (Attachment)
 Dim EmailSend As Object
 Dim EmailApp As Object
 
 DoCmd.OutputTo acOutputReport, "REP09emailnotification", acFormatPDF, "x:\tenders\group tendering database\TenderUpdate.pdf", False
 
'Start notes session
    Set Session = CreateObject("Notes.NotesSession")
'Open the mail database in notes
 
    Set Maildb = Session.GetDatabase("", "names.nsf")
 
        If Maildb.IsOpen = True Then
            'Already open for mail
        Else
            Maildb.OPENMAIL
        End If
 
'Set up the new mail doc
    If (Not (strRecipient = "")) Then
        Set MailDoc = Maildb.CreateDocument
        MailDoc.Form = "Memo"
        MailDoc.sendto = strRecipient
        MailDoc.Subject = strSubject
        MailDoc.Body = strBodyText & vbCrLf & vbCrLf & strExtraText
'Set up the embedded object and attachment and attach it
 
        Set AttachME = MailDoc.CreateRichTextItem("x:\tenders\group tendering database\TenderUpdate.pdf")
        Set EmbedObj = AttachME.EmbedObject(1454, "", "x:\tenders\group tendering database\TenderUpdate.pdf")
 
'Send the mail
        MailDoc.Send 1, strRecipient
    Else
        MsgBox Err
 
    End If
 
'Clean up
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set Session = Nothing
    Set AttachME = Nothing
    Set EmbedObj = Nothing
    Kill ("x:\tenders\group tendering database\TenderUpdate.pdf")
 
End Function

In the Event that calls the function, I have this...

Code:
Private Sub cmdSave_Click()
On Error GoTo Err_cmdSave_Click
Dim strlist As String
Dim RecipList As String
Dim Subject As String
Dim BodyText As String
Dim AdditComments As String
Dim x As Integer
Dim db As DAO.Database, rs As DAO.Recordset
 
    If IsNull(EnquiryNumber) Then
        If MsgBox("Nothing to Save!" & vbCrLf & "Do you wish to close the form instead?", vbYesNo) = vbYes Then
            DoCmd.Close
            Exit Sub
        Else
        'do nowt
        Exit Sub
        End If
    End If
 
    If Me.txtValue = 0 Then
        If MsgBox("You have not specified a value for this tender - do you wish to proceed anyway?", vbYesNo, "Invalid Entry") = 7 Then
            DoCmd.CancelEvent
        Else
            Me.LastUpdateBy = CurrentUser()
            Me.LastUpdateDate = Now()
            DoCmd.RunCommand acCmdSaveRecord
 
        End If
    End If
 
    'if it's a newrecord then send out an email
    If Me.txtPrinted = False Then
 
        DoCmd.RunCommand acCmdSaveRecord
        'get the addressee list
        Set db = CurrentDb
        Set rs = db.OpenRecordset("qryRecipients")
 
            rs.MoveFirst
                Do While Not rs.EOF
                RecipList = RecipList & rs.Fields("recipients") & "; "
            rs.MoveNext
            Loop
 
            RecipList = Left(RecipList, Len(RecipList) - 1)
 
 
        'set up the content of the email
        Subject = "Notification of a new Tender - " & Me.Customer_Name & " ( " & Me.Status & " ) "
        BodyText = "A new tender has just been added to the Company Tenders database - please see attached file for details. " & vbCrLf & vbCrLf & "Please ensure this email is forwarded to the following people: " & RecipList
 
        If Not IsNull(Me.Comments) Then AdditComments = "Tender Comments:" & vbCrLf & vbCrLf & Me.EmailComments Else AdditComments = ""
 
        'send it
        x = MailLotusApp(RecipList, Subject, BodyText, AdditComments)
 
 
        'clean up
        Set db = Nothing
        Set rs = Nothing
 
        'set the 'Printed' flag
        Me.txtPrinted = True
        DoCmd.RunCommand acCmdSaveRecord
    End If
 
 
Exit_cmdSave_Click:
    Exit Sub
Err_cmdSave_Click:
    MsgBox Err & "  - " & Err.Description
    Resume Exit_cmdSave_Click
 
End Sub

It all works fine, except only the FIRST person on the recipients list gets the email - the others don't (which is why I've added a copy of the recipients list into the body of the email, so that they can just forward it on by copying and pasting the list into the 'To' box! Bit of a bodge, but I was stuck!)
 

pr2-eugin

Super Moderator
Local time
Today, 09:38
Joined
Nov 30, 2011
Messages
8,494
So sorry, I did not look that you were using Lotus.. :eek:

Although I have not worked with it, simple read ups suggests it looks for a 1D array..

So how about this piece of code?
Code:
Function MailLotusApp(strRecipient As String, strSubject As String, strBodyText As String, strExtraText As String)
    [COLOR=Green]'This function sends the mail
    'Setup the objects required for Automation into Lotus notes[/COLOR]
    Dim Maildb As Object [COLOR=Green]' The mail database[/COLOR]
    Dim UserName As String[COLOR=Green] 'The users notes name[/COLOR]
    Dim MailDbName As String [COLOR=Green]' The users notes mail database name[/COLOR]
    Dim MailDoc As Object[COLOR=Green] ' The mail doc itself[/COLOR]
    Dim Session As Object[COLOR=Green] ' The notes session[/COLOR]
    Dim AttachME As Object[COLOR=Green] 'The attachment richtextfile object[/COLOR]
    Dim EmbedObj As Object [COLOR=Green]'The embedded object (Attachment)[/COLOR]
    Dim EmailSend As Object
    Dim EmailApp As Object
 
    DoCmd.OutputTo acOutputReport, "REP09emailnotification", acFormatPDF, "x:\tenders\group tendering database\TenderUpdate.pdf", False

    [COLOR=Green]'Start notes session[/COLOR]
    Set Session = CreateObject("Notes.NotesSession")
    
   [COLOR=Green] 'Open the mail database in notes[/COLOR]
    Set Maildb = Session.GetDatabase("", "names.nsf")

    If Not Maildb.IsOpen Then Maildb.OPENMAIL

    [COLOR=Green]'Set up the new mail doc[/COLOR]
    If Len(strRecipient & vbNullString) <> 0 Then
        [COLOR=Red][B]Dim recArr()
        recArr = Split(strRecipient, ";")[/B][/COLOR]
        Set MailDoc = Maildb.CreateDocument
        MailDoc.Form = "Memo"
        MailDoc.sendto =[COLOR=Red][B] recArr[/B][/COLOR]
        MailDoc.Subject = strSubject
        MailDoc.Body = strBodyText & vbCrLf & vbCrLf & strExtraText
        [COLOR=Green]'Set up the embedded object and attachment and attach it[/COLOR]

        Set AttachME = MailDoc.CreateRichTextItem("x:\tenders\group tendering database\TenderUpdate.pdf")
        Set EmbedObj = AttachME.EmbedObject(1454, "", "x:\tenders\group tendering database\TenderUpdate.pdf")

       [COLOR=Green] [/COLOR][COLOR=Green]'Send the mail[/COLOR]
        MailDoc.Send 1, [COLOR=Red][B]recArr[/B][/COLOR]
    Else
        MsgBox Err
    End If

   [COLOR=Green] [/COLOR][COLOR=Green]'Clean up[/COLOR]
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set Session = Nothing
    Set AttachME = Nothing
    Set EmbedObj = Nothing
    Kill ("x:\tenders\group tendering database\TenderUpdate.pdf")
End Function
 

CazB

Registered User.
Local time
Today, 09:38
Joined
Jul 17, 2013
Messages
309
Thanks Paul - but now I get Error 13 - type mismatch?

Lotus Notes is a swine, lol
 

pr2-eugin

Super Moderator
Local time
Today, 09:38
Joined
Nov 30, 2011
Messages
8,494
I guess the Error is on the Split function? Thought that might be the case.. Because Split returns a String array.. Declare the array as String.. It might help with the error, but not sure if sendTo method will be happy about that..
 

CazB

Registered User.
Local time
Today, 09:38
Joined
Jul 17, 2013
Messages
309
Never did get to the bottom of this, but I found a workaround so I'm marking this as solved ;)
 

pr2-eugin

Super Moderator
Local time
Today, 09:38
Joined
Nov 30, 2011
Messages
8,494
Awesome, can you please share the solution? So I and other can learn?
 

CazB

Registered User.
Local time
Today, 09:38
Joined
Jul 17, 2013
Messages
309
It's a bit of a bodge really - but what I did in the end was to create a Public mailing list on our mail server, and then just use that email adddress rather than using a loop to get the data from a table... thereby getting around the fact that Notes doesn't like sending to more than one recipient!

So my code finished up looking like this:

Code:
Private Sub cmdSave_Click()
On Error GoTo Err_cmdSave_Click
Dim strlist As String
Dim MainRecip As String
Dim RecipList As String
Dim Subject As String
Dim BodyText As String
Dim AdditComments As String
    
    If IsNull(EnquiryNumber) Then
        If MsgBox("Nothing to Save!" & vbCrLf & "Do you wish to close the form instead?", vbYesNo) = vbYes Then
            DoCmd.Close
            Exit Sub
        Else
        'do nowt
        Exit Sub
        End If
    End If
        
    If Me.txtValue = 0 Then
        If MsgBox("You have not specified a value for this tender - do you wish to proceed anyway?", vbYesNo, "Invalid Entry") = 7 Then
            DoCmd.CancelEvent
            Exit Sub
        Else
            Me.LastUpdateBy = CurrentUser()
            Me.LastUpdateDate = Now()
            DoCmd.RunCommand acCmdSaveRecord
        End If
    End If
    
    'if it's a newrecord then send out an email
    If Me.txtPrinted = False Then
    
        DoCmd.RunCommand acCmdSaveRecord
        'get the addressee list
                
        MainRecip = "[EMAIL="tenders@somecompany.co.uk"]tenders@somecompany.co.uk[/EMAIL]"
        
        'set up the content of the email
        Subject = "Notification of a new Tender - " & Me.Customer_Name & " ( " & Me.Status & " ) "
        BodyText = "A new tender has just been added to the Tenders database - please see attached file for details. "
        
        If Not IsNull(Me.EmailComments) Then AdditComments = "Tender Comments:" & vbCrLf & vbCrLf & Me.EmailComments Else AdditComments = ""
        
        'send it
        Call MailLotusApp(MainRecip, Subject, BodyText, AdditComments)
        
        
        'clean up
        Subject = ""
        BodyText = ""
        AdditComments = ""
        MainRecip = ""
                
        'set the 'Printed' flag
        Me.txtPrinted = True
    End If
    
        
Exit_cmdSave_Click:
    Exit Sub
Err_cmdSave_Click:
    MsgBox Err & "  - " & Err.Description
    Resume Exit_cmdSave_Click
    
End Sub

And the Code for the MailLotusApp function:

Code:
Function MailLotusApp(strRecipient As String, strSubject As String, strBodyText As String, strExtraText As String)
'This function sends the mail
 
'Setup the objects required for Automation into Lotus notes
 Dim Maildb As Object ' The mail database
 Dim UserName As String 'The users notes name
 Dim MailDbName As String ' The users notes mail database name
 Dim MailDoc As Object ' The mail doc itself
 Dim Session As Object ' The notes session
 Dim AttachME As Object 'The attachment richtextfile object
 Dim EmbedObj As Object 'The embedded object (Attachment)
 Dim EmailSend As Object
 Dim EmailApp As Object
 
 DoCmd.OutputTo acOutputReport, "REP09emailnotification", acFormatPDF, "x:\tenders\group tendering database\TenderUpdate.pdf", False

'Start notes session
    Set Session = CreateObject("Notes.NotesSession")
'Open the mail database in notes
 
    Set Maildb = Session.GetDatabase("", "names.nsf")
        
        If Maildb.IsOpen = True Then
            'Already open for mail
        Else
            Maildb.OPENMAIL
        End If
        
'Set up the new mail doc
    If (Not (strRecipient = "")) Then
        Set MailDoc = Maildb.CreateDocument
        MailDoc.Form = "Memo"
        MailDoc.sendto = strRecipient
        MailDoc.Subject = strSubject
        MailDoc.Body = strBodyText & vbCrLf & vbCrLf & strExtraText
'Set up the embedded object and attachment and attach it
    
        Set AttachME = MailDoc.CreateRichTextItem("x:\tenders\group tendering database\TenderUpdate.pdf")
        Set EmbedObj = AttachME.EmbedObject(1454, "", "x:\tenders\group tendering database\TenderUpdate.pdf")
    
'Send the mail
        MailDoc.Send 1, strRecipient
    Else
        MsgBox Err
        
    End If
 
'Clean up
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set Session = Nothing
    Set AttachME = Nothing
    Set EmbedObj = Nothing
    Kill ("x:\tenders\group tendering database\TenderUpdate.pdf")
 
End Function
 

tranchemontaigne

Registered User.
Local time
Today, 01:38
Joined
Aug 12, 2008
Messages
203
I suspect your type mismatch is due to Lotus expecting an array of type variant.

Here's the reference I've used before

http://www.fabalou.com/VBandVBA/lotusnotesmail.asp


Here's the code I wrote about 10 years ago

Code:
Option Compare Database
Option Explicit
Private Const gstrObject = "basE-Mail Module"
Private strError_Message As String
Public Function fnSendNotesMail( _
    Recipient As Variant, Subject As String, _
    bodytext As String, SaveIt As Boolean, _
    Optional Attachment As String = "", _
    Optional CCRecipient As Variant = "", _
    Optional bccRecipient As Variant = "")
'//////////////////////////////////////////////////////////////////
'// Function: fnSendNotesMail
'//////////////////////////////////////////////////////////////////
'// Author: John Hawkins
'//////////////////////////////////////////////////////////////////
'// Revision History:
'//     17 Jul 2013     tranchemontaigne    -Added documentation
'//                                     -Added error logging
'//
'//////////////////////////////////////////////////////////////////
'// Description:
'//     This public sub will send a mail and attachment if
'//     neccessary to the recipient including the body text.
'//
'//////////////////////////////////////////////////////////////////
'// Requirements:
'//     Requires that notes client is installed on the system.
'//
'//////////////////////////////////////////////////////////////////
'// Inputs:
'//     Argument    Type    Content
'//     -----------------------------------------------------------
'//     Subject     string  e-mail message subject
'//     attachment  string  e-mail message attachment
'//     recipient   string  message recipient
'//     bodytext    string  body of e-mail message
'//     saveit      bool    asd
'//
'//////////////////////////////////////////////////////////////////
'// Legal Disclaimer:
'//     This code is based upon code and application content
'//     downloaded from its copyright owner, of Smiley I.T. and as
'//     such reproduction in any form which is for commercial use
'//     requires the permission of the Webmaster.  Any use of this
'//     code for non-commercial use only requires a link or comment
'//     back to the original page you took the code from.
'//
'// Source:
'//     [URL]http://www.fabalou.com/vbandvba/lotusnotesmail.asp[/URL]
'//
'// CT's Note:
'//     Commercial use has been defined in at least one instance as
'//     "Any wholesale, retail,or service business activity
'//     established to carry on trade for profit."
'//     Source: [URL="http://www.co.loudoun.va.us/compplan/glossary.htm"]www.co.loudoun.va.us/compplan/glossary.htm[/URL]
'//
'//////////////////////////////////////////////////////////////////
'// CC or BCC message:
'//     Send a message to more than one person or copy or blind
'//     carbon copy
'//
'// Sample Code:
'//     MailDoc.sendto = Recipient
'//     MailDoc.CopyTo = ccRecipient
'//     MailDoc.BlindCopyTo = bccRecipient
'//
'//////////////////////////////////////////////////////////////////
'// Multiple e-mail addresses:
'//     For multiple email addresses set MailDoc.sendto to an
'//     array of variants each of which will receive the message.
'//
'// Sample Code:
'//     Dim recip(25) As Variant
'//     recip(0) = "emailaddress1"
'//     recip(1) = "emailaddress2" e.t.c
'//
'//     MailDoc.sendto = recip
'//
'//////////////////////////////////////////////////////////////////
On Error GoTo Err_fnSendNotesMail
'Set up the objects required for Automation into lotus notes
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'The current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)
 
    'Start a session to notes
    Set Session = CreateObject("Notes.NotesSession")
 
    'Next line only works with 5.x and above. Replace password with your password
    'Session.Initialize ("password")
 
    'Get the sessions username and then calculate the mail file name
    'You may or may not need this as for MailDBname with some systems you
    'can pass an empty string or using above password you can use other mailboxes.
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, _
        (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
 
    'Open the mail database in notes
    Set Maildb = Session.GETDATABASE("", MailDbName)
     If Maildb.ISOPEN = True Then
          'Already open for mail
     Else
         Maildb.OPENMAIL
     End If
 
    'Set up the new mail document
    Set MailDoc = Maildb.CREATEDOCUMENT
    MailDoc.Form = "Memo"
    MailDoc.sendto = Recipient
 
 
    If CCRecipient(1) <> "" Then
        MailDoc.CopyTo = CCRecipient
    End If
    If bccRecipient(1) <> "" Then
        MailDoc.BlindCopyTo = bccRecipient
    End If
    MailDoc.Subject = Subject
    MailDoc.Body = bodytext
    MailDoc.SAVEMESSAGEONSEND = SaveIt
 
    'Set up the embedded object and attachment and attach it
    If Attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
        'MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
 
    'Send the document
    MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
    MailDoc.SEND 0, Recipient
 
 
Exit_fnSendNotesMail:
    'Clean Up
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
 
    Exit Function
 
Err_fnSendNotesMail:
    strError_Message = "Error: " & Chr(10) & Chr(13) & _
        "     " & Err.Number & ": " & Err.Description
    MsgBox strError_Message, vbCritical, "Error: cmdNetworkPath_Click"
 
    Call fnLogError(gstrObject, "cmdNetworkPath_Click", strError_Message)
    Resume Exit_fnSendNotesMail
End Function


Code:
Option Compare Database
Option Explicit
Private Const gstrObject = "Form_frmDetermineIfEMailShouldBeSent"
Private strError_Message As String
Private Sub cmdSendEmail_Click()
'//////////////////////////////////////////////////////////////////
'// Subroutine: cmdSendEmail_Click
'//////////////////////////////////////////////////////////////////
'// Author: tranchemontaigne '//////////////////////////////////////////////////////////////////
'// Revision History:
'//     Date            Editor          Description
'//     ----------------------------------------------------------
'//     17 Jul 2013     tranchemontaigne     -Updated documentation
'//                                     -Added error handling
'//
'//////////////////////////////////////////////////////////////////
'// Description:
'//     This private sub reads in values from a form and passes
'//     those values through to the SendNotesMail function stored
'//     within the E-Mail module.
'//
'//     To prevent errors with optional arguments, checking is done
'//     to ensure that optional arguments will be passed when the
'//     value of those optional arguments is null.
'//
'//////////////////////////////////////////////////////////////////
'// Requirements:
'//     Microsoft Visual Basic for Applications
'//     Microsoft Access 9.0 Object Library
'//     fnLogError          (basErrorLog module)
'//     fnSendNotesMail     (basE-Mail module)
'//     fnTokenize          (basStrings module)
'//
'//////////////////////////////////////////////////////////////////
On Error GoTo Err_cmdSendEmail_Click
 
'declare variables
Dim strSubject As String
Dim strAttachment As String
Dim strRecipient As Variant 'String
Dim strBodyText As String
Dim blSaveIt As Boolean
Dim strCCRecipient As Variant 'String
Dim strBCCRecipient As Variant 'String
'//////////////////////////////////////////////////////////////////
'// For multiple recipient addresses, use an array and supply the
'// name of the array to the function in place of a string.
'//
'// A combination of instr/mid functions could be used to tokenize
'// the values stored within a text box to populate array elements
'// based upon a comma delimiter.
'//
'// Attention should be paid to the situation when no comma exists
'// because of a single address.
'//
'//         Dim recip(25) As Variant
'//             recip(0) = "emailaddress1"
'//             recip(1) = "emailaddress2"
'//
'//////////////////////////////////////////////////////////////////
    'initialize required arguments
    strRecipient = [Forms]![frmEMail]![txtRecipient].Value
    strSubject = [Forms]![frmEMail]![txtSubject].Value
    strBodyText = [Forms]![frmEMail]![txtBodyText].Value
    blSaveIt = [Forms]![frmEMail]![txtSaveIt].Value
    'initialize optional arguments
    If [Forms]![frmEMail]![txtCCRecipient].Value <> "" Then
        strCCRecipient = [Forms]![frmEMail]![txtCCRecipient].Value
    End If
 
    If [Forms]![frmEMail]![txtBCCRecipient].Value <> "" Then
        strBCCRecipient = [Forms]![frmEMail]![txtBCCRecipient].Value
    End If
 
    If [Forms]![frmEMail]![txtAttachment].Value <> "" Then
        strAttachment = [Forms]![frmEMail]![txtAttachment].Value
    End If
 
    'send e-mail message based upon arguments defined above
    Call fnSendNotesMail(fnTokenize(strRecipient), strSubject, strBodyText, blSaveIt, _
        strAttachment, fnTokenize(strCCRecipient), fnTokenize(strBCCRecipient))
    'notify user that e-mail message has been sent
    MsgBox "Your message has been sent."
 
Exit_cmdSendEmail_Click:
    Exit Sub
 
Err_cmdSendEmail_Click:
        strError_Message = Err.Number & ": " & Err.Description & Chr(10) & Chr(13) & _
        "     strRecipient: " & strRecipient & Chr(10) & Chr(13) & _
        "     strCCRecipient: " & strCCRecipient & Chr(10) & Chr(13) & _
        "     strBCCRecipient: " & strBCCRecipient & Chr(10) & Chr(13) & _
        "     strSubject: " & strSubject & Chr(10) & Chr(13) & _
        "     strBodyText: " & strBodyText & Chr(10) & Chr(13) & _
        "     blSaveIt: " & blSaveIt & Chr(10) & Chr(13)
    MsgBox strError_Message, vbCritical, "Error: cmdSendEmail_Click"
 
    Call fnLogError(gstrObject, "cmdSendEmail_Click", strError_Message)
    Resume Exit_cmdSendEmail_Click
End Sub

The last function is less than perfect, but works
Code:
Option Compare Database
Option Explicit
Public Const intArraySize As Integer = 25
Private Const gstrObject = "basStrings Module"
Private strError_Message As String
 
Public Function fnTokenize(strString As Variant)
'//////////////////////////////////////////////////////////////////
'// Function: fnTokenize
'//////////////////////////////////////////////////////////////////
'// Author: tranchemontaigne '//////////////////////////////////////////////////////////////////
'// Modified:
'//     Date            Editor          Description
'//     ----------------------------------------------------------
'//     18 Jul 2013     tranchemontaigne -Added documentation
'//                                    -Added error handling
'//
'//////////////////////////////////////////////////////////////////
'// Description:
'//     receives a string of comma separated variables and converts
'//     into an array of size intArraySize
'//
'//////////////////////////////////////////////////////////////////
'// Requirements:
'//     Microsoft Visual Basic for Applications
'//     Microsoft Access 9.0 Object Library
'//     fnLogError      (ErrorLog module)
'//
'//////////////////////////////////////////////////////////////////
On Error GoTo Err_fnTokenize
'declare variables
Dim TokenArray(1 To intArraySize) As String
Dim intCharPosition As Integer
Dim intStartCharPosition As Integer
Dim intNextCharPosition As Integer
Dim intTokenLength As Integer
Dim intLoopCounter As Integer
Dim intStringLength As Integer
    'test for null argument
    If IsNull(strString) Then
        For intLoopCounter = 1 To intArraySize
            TokenArray(intLoopCounter) = ""
        Next
 
    Else
        'initialize variables
        intStringLength = Len(strString) + 1
        intStartCharPosition = 1
 
        intNextCharPosition = InStr((intStartCharPosition + 1), strString, ",")
 
        If (intNextCharPosition < intStartCharPosition) Or (intNextCharPosition = 0) Then
            intNextCharPosition = intStringLength
        End If
 
 
 
 
        For intLoopCounter = 1 To intArraySize
 
        If (intNextCharPosition < intStartCharPosition) Or (intNextCharPosition = intStartCharPosition) Then
                intNextCharPosition = intStringLength
            Else
                intTokenLength = (intNextCharPosition) - (intStartCharPosition)
                TokenArray(intLoopCounter) = Mid(strString, intStartCharPosition, intTokenLength)
                intStartCharPosition = (intNextCharPosition + 1)
                intNextCharPosition = InStr((intStartCharPosition + 1), strString, ",")
            End If
 
        Next
 
    End If
 
    fnTokenize = TokenArray
Exit_fnTokenize:
    Exit Function
 
Err_fnTokenize:
    strError_Message = "Error: " & Chr(10) & Chr(13) & _
        "     " & Err.Number & ": " & Err.Description
    MsgBox strError_Message, vbCritical, "Error: fnRecordLogout"
 
    Call fnLogError(gstrObject, "fnRecordLogout", strError_Message)
Resume Exit_fnTokenize
 
End Function
 
Last edited:

Users who are viewing this thread

Top Bottom