MS Access - VBA：使用表格中的电子邮件地址发送电子邮件

Question

使用 MS Access VBA。设置如下：

• tblUsers 包含 UserID、UserName、UserSecurityLevel、UserEmail

• tblStewards 包含 AreaID、AreaName、Stewards，其中 Stewards 设置为来自查找查询“SELECT tblUsers.ID, tblUsers.UserName FROM tblUsers”的组合框，并且我允许多个值（例如，每个区域有多个管家）； Stewards 字段的数据类型为短文本

• frmStewardRequest 具有记录源 tblStewards，专为用户请求区域管家添加新项目而设计；它包含 cmbAreaName、txtStewards（基于 cmbAreaName 和 Control Source Stewards 自动填充）、一些用于提供请求项目的开放文本字段以及 btnSubmitRequest

• 对于 btnSubmitRequest，我有一个 On Click 事件，它使用此 VBA 代码向区域管理员生成电子邮件：

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

获取区域管理员的电子邮件地址时出现问题：这似乎不是一个字符串。如何获取电子邮件地址以便正确发送？ （不太重要的问题，有没有办法防止弹出框接受发送这封邮件的风险？）

Answer 1

我就是这样做的。

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

• 表tblStewards组合框查找查询SELECT tblUsers.ID, tblUsers.UserName FROM tblUsers需要修复，因为没有ID但UserID

• 已使用拆分功能检查多个 Steward 值，然后使用 Dlookup 获取其电子邮件 ID

• 我更喜欢使用多值字段，尤其是在查找列表不大的情况下（使用没有错）。

---

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