Question

我有一个内置在Access数据库中的警报发送辅助工具，可以一次性将电子邮件发送给所有技术已过期的技术人员。但是，每一封电子邮件都需要获得个人和明确的许可才能发送，这仅比发送爆炸邮件要快得多！

类似于this question和this question，但我需要一次自动发送多封电子邮件，而无需进行其他处理。问题中包含的代码似乎只发送一封电子邮件，唯一接受的答案是等待五秒钟（最多三秒钟），以检查是否已显示实际消息，以便SendKeys在该窗口上正常工作。 / p>

如果我使用SendKeys并内置5秒钟的暂停来等待确认as Graham Anderson suggests，这实际上并不会加快处理过程，只能避免一些额外的点击。警告（如下所示）上显示的进度条大约需要该时间来填充，因此我猜测这是构建电子邮件的系统，这是等待的时间。

同一问题也适用于Julia's answer，另一个问题-在进度条已满之前，警告框将不允许您单击“允许”，因此自动单击此按钮的代码将必须等待完成充其量。

我什至尝试了DoCmd.SetWarnings (False)（然后在发送后尝试DoCmd.SetWarnings (True)），但这并没有阻止这一特定事件。这可能是因为警告来自Outlook，而不是来自Access ...？

作为参考，这是我的编码：

Private Sub SendAlerts_Click()
Dim db As Database, rs As Recordset
Dim Subject As String, Body As String, EmailAddress As String
Dim Recipient As String, Induction As String, Expiry As String
Set db = CurrentDb
Set rs = db.OpenRecordset("qryExpiryAlert", dbOpenDynaset)

Do Until rs.EOF
    EmailAddress = rs!Email
    Recipient = rs!FullName
    Induction = rs!Induction
    Expiry = rs!ExpiryDate
    Subject = "Inductions need renewal"
    Body = "Hi " & Recipient & ", the expiry for your " & Induction & _
        " certificate is " & Expiry & ". Please send a current certificate asap."

    DoCmd.SendObject , , , EmailAddress, , , Subject, Body, False

    rs.MoveNext
Loop

DoCmd.Close

End Sub

这是警告：

Answer 1

我编写并编译了一个Autohotkey脚本，该脚本查找Outlook确认对话框并自动单击“允许”。（我从Access VBA调用它，可以设置关闭前运行的时间。）但是，正如您所指出的，每次等待启用“允许”按钮仍然有相当大的延迟。

最终，我们公司最终购买了Outlook Security Manager。与往常一样，您必须为项目添加Outlook Security Manager Reference.引用。

它基本上具有ON和OFF设置，因此易于使用。如果在标准模块中编写Sub来简化：

Public Sub SetSecurityManager(State As String)
    ' Turns the Security Manager on or off.
    ' The Security Manager allows the application to
    ' send emails through Outlook without having to
    ' manually confirm each outgoing email.

    Select Case State
        Case "On"
            ' Temporarily turn off Outlook security so we can send email
            Set SecurityManager = CreateObject("AddInExpress.OutlookSecurityManager")
            SecurityManager.DisableOOMWarnings = True
            SecurityManager.DisableSMAPIWarnings = True
        Case "Off"
            'Restore Outlook security to normal
            SecurityManager.DisableSMAPIWarnings = False
            SecurityManager.DisableOOMWarnings = False
            Set SecurityManager = Nothing
        Case Else
    End Select

End Sub

每当需要时，我都会在代码中添加以下行：

SetSecurityManager "On"

必须为购买的软件所产生的安全性问题的解决方案付费很令人沮丧，但这是我们找到的最佳答案。我每天发送150到225个报告，并且OSM没问题。

谢谢

基思

Answer 2

此代码似乎在没有警告的情况下发送电子邮件。

我从此页面获得了代码：

https://www.slipstick.com/outlook/rules/send-a-new-message-when-a-message-arrives/

Dim objMsg As MailItem         
Set objMsg = Application.CreateItem(olMailItem)

objMsg.Body = "Body goes here"
objMsg.Subject = "Subject goes here" 
objMsg.Recipients.Add "Email@Address.com"

objMsg.Send

摆脱针对vba发送的电子邮件的警告消息

2 个答案: