MS Access - VBA: Sending Email Using Email Addresses in Tables

Question

Using MS Access VBA. Setup is as follows:

tblUsers contains UserID, UserName, UserSecurityLevel, UserEmail
tblStewards contains AreaID, AreaName, Stewards where Stewards is set to be a Combo Box from a Lookup Query "SELECT tblUsers.ID, tblUsers.UserName FROM tblUsers" and I allow multiple values (e.g., each area has multiple stewards); the Stewards field has a data type of short text
frmStewardRequest has Record Source tblStewards and is designed for a user to request that the area stewards add a new item; it contains cmbAreaName, txtStewards which autopopulates based on cmbAreaName with Control Source Stewards, some open text fields for supplying the requested item, and a btnSubmitRequest
for btnSubmitRequest, I have an On Click event that generates an email to the area stewards using this VBA code:

Dim strEmailTo As String
Dim strTxtBody As String

strEmailTo = DLookup("[UserEmail]", "tblUsers", "ID = " & Me.txtSteward)

strTxtBody = "I need a new item in " & Me.cmbAreaName & "..."

DoCmd.SendObject , , acFormatTXT, strEmailTo, , , "New Item Request", strTxtBody, False

There is a problem with getting the email addresses for the area stewards: it doesn't seem this is a string. How can I get the email addresses so this will send properly? (Less important question, is there a way to prevent the pop-up box to Accept the risk of sending this email?)

https://stackoverflow.com/questions/1461582/multivalued-fields-a-good-idea --> they are not. — Andre, Jul 17 '18 at 14:14

score 1 · Answer 1 · answered Jul 17 '18 at 14:56

This is how I do it.

Option Compare Database
Option Explicit
' This database and all the code therein is © 1999-2002 Arvin Meyer arvinm@datastrat.com
' You are free to use this code and this database  in an application
'   as long as you do not publish it without the author's permission.
' Additionally, you are required to include this copyright notice in the application.

Private Sub Form_Open(Cancel As Integer)
On Error GoTo Err_OF
    Dim db As Database
    Dim i As Integer
    Dim contr As Container
    Dim strRptList As String
    Dim strRptName As String
    Dim Length As Integer

   Set db = CurrentDb()
   Set contr = db.Containers("Reports")

    strRptList = ""
    For i = 0 To contr.Documents.Count - 1
       strRptName = contr.Documents(i).name
            If strRptList <> "" Then strRptList = strRptList & "; "
            Length = Len(strRptName)
            strRptList = strRptList & strRptName
    Next i

  Me!lstRpt.RowSource = strRptList

Exit_OF:
     Exit Sub
Err_OF:
    MsgBox Err & " " & Error, , "Report Open"
    Resume Exit_OF

End Sub


Private Sub cmdEmail_Click()
On Error GoTo Err_cmdEmail_Click

    Dim strDocName As String
    Dim strEmail As String
    Dim strMailSubject As String
    Dim strMsg As String

    strDocName = Me.lstRpt
    strEmail = Me.txtSelected & vbNullString
    strMailSubject = Me.txtMailSubject & vbNullString
    strMsg = Me.txtMsg & vbNullString & vbCrLf & vbCrLf & "Your Name" & _
        vbCrLf & "MailTo:youremail@nowhere.com"

    DoCmd.SendObject objecttype:=acSendReport, _
        ObjectName:=strDocName, outputformat:=acFormatHTML, _
        To:=strEmail, Subject:=strMailSubject, MessageText:=strMsg

Exit_cmdEmail_Click:
    Exit Sub

Err_cmdEmail_Click:
    MsgBox Err.Description
    Resume Exit_cmdEmail_Click

End Sub

Private Sub Label15_Click()
Dim hplMail As String
hplMail = "#MailTo:email_senate@datastrat.com#"
Application.FollowHyperlink HyperlinkPart(hplMail, acAddress)
End Sub

Private Sub lstRpt_Click()
    Me.cmdEmail.Enabled = True
End Sub

Private Sub lstMailTo_Click()
Dim varItem As Variant
Dim strList As String

With Me!lstMailTo
    If .MultiSelect = 0 Then
        Me!txtSelected = .Value
    Else
        For Each varItem In .ItemsSelected
            strList = strList & .Column(0, varItem) & ";"
        Next varItem
        strList = Left$(strList, Len(strList) - 1)
        Me!txtSelected = strList
    End If
End With
End Sub

Thanks. Moral of the story is not to use multivalued fields. — Pat, Jul 17 '18 at 18:29
Go ahead and mark this as helpful is it actually helped you resolve the issue. — ASH, Jul 17 '18 at 18:36

score 0 · Answer 2 · answered Jul 17 '18 at 18:40

Table tblStewards Combo Box lookup query SELECT tblUsers.ID, tblUsers.UserName FROM tblUsers needs to be fixed since there is no ID but UserID
Have used the Split function to check for multiple Steward values and then get their email id using Dlookup
I prefer using MultiValued fields especially when lookup list is not huge (nothing wrong to use).

Dim strStewards As Variant
Dim i As Long

Dim strEmailTo As String
Dim strTxtBody As String


strStewards = Split(Me.txtSteward, ",")
For i = LBound(strStewards) To UBound(strStewards)
    strEmailTo = strEmailTo & ";" & Nz(DLookup("[UserEmail]", "tblUsers", "UserID=" & strStewards(i)), "")
Next

strTxtBody = "I need a new item in " & Me.cmbAreaName & "..."

DoCmd.SendObject , , acFormatTXT, strEmailTo, , , "New Item Request", strTxtBody, False

MS Access - VBA: Sending Email Using Email Addresses in Tables

2 Answers2