使用 VBA 对电子邮件地址运行 Access Query 以用作生成电子邮件的电子邮件收件人

Question

我正在运行一个查询 EmailList，它会提取访问表单上显示的人员的电子邮件地址。查询本身运行正常，用预期的收件人填充字段电子邮件。我想使用 VBA 将此查询中显示的电子邮件复制到新电子邮件中，并将它们列为收件人。我需要电子邮件为 html，因为我在电子邮件正文中附加了一个超链接。

Set OutApp = CreateObject("outlook.application")
OutApp.Session.Logon
Set OutMail = OutApp.createitem(0)

Dim rs As DAO.Recordset
Dim qry As DAO.QueryDefs
Dim CurrentDb As DAO.Database
Dim OlApp As Object
Dim OlMail As Object
Dim ToRecipient As String

  Set OlApp = CreateObject("Outlook.Application")
  Set OlMail = OlApp.createitem(olmailitem)
  Set rs = CurrentDb.OpenRecordset("SELECT Email FROM [EmailList]")

  Do While rs.EOF = False
    ToRecipient = rs!Email
    OlMail.Recipients.Add ToRecipient
    rs.MoveNext
  Loop

With OutMail
    .Subject = "MOC"
    .HTMLbody = "<a href=""X:\MOC Training.accdb"">Click Here for Training</a><br>"
    .Display
End With
Set OutMail = Nothing
Set OutApp = Nothing

玩这个时，我的收件人只有空白，或者我的“Set rs”行项目出错。我对 VBA 很陌生，所以我不明白这个错误。

参见下面的 SQL 代码：

SELECT Employees.Email
FROM Employees LEFT JOIN Names2 ON Employees.Employee = Names2.[Names Trainee]
WHERE (((Names2.MOC)=[Forms]![Input MOC]![cboMOC#]));

Answer 1

相同类型的 Outlook 对象的多个变量然后不一致地使用变量。不要将 CurrentDb 用作已声明的变量 - 它已经是一个内在常量。不需要 ToRecipient 变量。

此代码对我有用。

Dim rs As DAO.Recordset
Dim OlApp As Object
Dim OlMail As Object

Set OlApp = CreateObject("Outlook.Application")
Set OlMail = OlApp.CreateItem(0)
Set rs = CurrentDb.OpenRecordset("SELECT Email FROM [EmailList]")

With OlMail    
    Do While rs.EOF = False
        .Recipients.Add rs!Email
        rs.MoveNext
    Loop
    .Subject = "MOC"
    .HTMLbody = "<a href=""X:\MOC Training.accdb"">Click Here for Training</a><br>"
    .Display
End With
Set OlMail = Nothing
Set OlApp = Nothing

Answer 2

您的直接问题是OpenRecordset，与 Outlook 没有任何关系。因此，让我们暂时忽略 Outlook 位，专注于 OpenRecordset 问题。

发生错误是因为OpenRecordset 无法从您的组合框中检索值：

WHERE (((Names2.MOC)=[Forms]![Input MOC]![cboMOC#]))

相反，它将[Forms]![Input MOC]![cboMOC#] 视为您尚未为其提供值的参数。因此，在调用OpenRecordset 之前提供该值。

将此代码粘贴到新过程中并运行它。您可以在立即窗口中查看Debug.Print 输出； Ctrl+g 会带你去那里。

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim strSelect As String
strSelect = "SELECT e.Email FROM Employees As e " & _
    "INNER JOIN Names2 As n ON e.Employee = n.[Names Trainee] " & _
    "WHERE n.MOC=[Forms]![Input MOC]![cboMOC#];"
Debug.Print "strSelect: " & strSelect
Debug.Print "combo box: " & [Forms]![Input MOC]![cboMOC#].Value

Set db = CurrentDb
Set qdf = db.CreateQueryDef(vbNullString, strSelect)
qdf.Parameters(0).Value = [Forms]![Input MOC]![cboMOC#].Value
Set rs = qdf.OpenRecordset
Do While Not rs.EOF
    Debug.Print rs!Email
    rs.MoveNext
Loop

如果记录集在立即窗口中打开并打印正确的数据，请修改您的原始代码以以相同方式处理记录集。如果此代码失败，请向我们显示 strSelect 和组合框的值、完整的错误消息以及该代码的哪一行触发了该错误。