使用 VBA 禁用 Outlook 安全设置

Question

我正在尝试使用宏中的 VBA 自动通过电子邮件发送报告。该报告是由outlook2007从Access2007发送的。发送报告时，我从 Outlook 收到一条安全消息，提示“某个程序正在尝试访问您的地址簿或联系人”或“某个程序正在尝试访问您存储在 Outlook 中的电子邮件地址...”。这条消息对我来说是一个问题，因为我想使用 Windows 任务计划程序自动发送报告，而无需任何人工交互。所以我想禁用此安全通知。我在谷歌上搜索，这是我到目前为止的代码，但给了我错误，我不知道我还应该做什么。提前感谢您的帮助。我是一名初学者程序员。错误是

Public Sub Send_Report()
Dim strRecipient As String
Dim strSubject As String
Dim strMessageBody As String
Dim outlookapp As Outlook.Application

Set outlookapp = CreateObject("Outlook.Application")

OlSecurityManager.ConnectTo outlookapp   'error is here says object required

OlSecurityManager.DisableOOMWarnings = True
On Error GoTo Finally

strRecipient = "[email protected]"
strSubject = "Tile of report"
strMessageBody = "Here is the message."

DoCmd.SendObject acSendReport, "Report_Name", acFormatPDF, strRecipient, , ,        strSubject, strMessageBody, False

Finally:
OlSecurityManager.DisableOOMWarnings = False


End Sub

Answer 1

您收到错误是因为 OlSecurityManager 什么都没有。您还没有声明它，也没有将其设置为任何内容，因此当您尝试使用它时，VBA 不知道您在说什么！

您似乎正在尝试使用 Outlook 安全管理器，这是一个出售的加载项

如果您确实拥有它，那么您可能需要像这样声明和设置它：

Dim OlSecurityManager As AddinExpress.Outlook.SecurityManager
Set OlSecurityManager = New AddinExpress.Outlook.SecurityManager

如果您（我怀疑）没有它，那么另一种选择是使用 CDO 发送电子邮件。下面是一个例子：

首先，在“工具”>“工具”中设置对 CDO 库的引用。参考文献>> Microsoft CDO for Windows Library 旁边的复选标记或类似内容。

Dim cdoConfig
Dim msgOne

Set cdoConfig = CreateObject("CDO.Configuration")
With cdoConfig.Fields
    .Item(cdoSendUsingMethod) = cdoSendUsingPort
    .Item(cdoSMTPServerPort) = 25 'your port number, usually is 25
    .Item(cdoSMTPServer) = "yourSMTPserver.com" 
    '.Item(cdoSendUserName) = "your username if required"
    '.Item(cdoSendPassword) = "your password if required"
    .Update
End With

Set msgOne = CreateObject("CDO.Message")
With msgOne
    Set .Configuration = cdoConfig
    .To = "[email protected]"
    .from = "[email protected]"
    .subject = "Testing CDO"
    .TextBody = "It works just fine."
    .Attachments.Add "C:\myfile.pdf"
    .Send
End With

这比 Outlook 有点烦人，因为您需要提前知道要使用的 SMTP 服务器的地址。

Answer 2

我知道这是一个迟到的答案，但我刚刚遇到了类似的问题。还有另一个使用 Outlook.Application 的解决方案！

我在寻找解决方案时偶然发现了它，这里完全归功于：
http://www.tek-tips.com/faqs.cfm?fid=第 4334

章 以下：

Sub Mail_workbook_Outlook()
'Working in Excel 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = "[email protected]"
        .CC = ""
        .BCC = ""
        .Subject = "This is an automated email!"
        .Body = "Howdy there! Here, have an automated mail!"
        .Attachments.Add ActiveWorkbook.FullName
        .Display 'Display instead of .send
        SendKeys "%{s}", True 'send the email without prompts
    End With
    On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
    End
End Sub