Question

使用MS Access VBA。设置如下：

tblUsers包含用户ID，用户名，UserSecurityLevel，用户电子邮件
tblStewards包含AreaID，AreaName，Stewards，其中“ Stewards”被设置为通过查找查询“ SELECT tblUsers.ID，tblUsers.UserName FROM tblUsers”创建的组合框，并且我允许多个值（例如，每个区域都有多个管家）; “管理员”字段的数据类型为短文本
frmStewardRequest具有记录源tblStewards，旨在供用户请求区域管理员添加新项目；它包含cmbAreaName，基于cmbAreaName和Control Source Stewards自动填充的txtStewards，一些用于提供请求项的打开文本字段以及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
已使用“拆分”功能检查多个管家值，然后使用Dlookup获取其电子邮件ID
我更喜欢使用MultiValued字段，尤其是在查找列表不大（使用时没有错）的情况下。

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：使用表中的电子邮件地址发送电子邮件

2 个答案: