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

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?)

Answer 1

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

Answer 2

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