使用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

在玩这个时，我只会将空白作为我的收件人，或者在我的“设置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

您的直接问题是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和组合框的值，完整的错误消息以及此代码的哪一行触发该错误。

Answer 2

相同类型的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